home *** CD-ROM | disk | FTP | other *** search
/ Utilities Professional 1-1500 / Utilities Professional 1-1500 (1994)(WPD)[!].iso / 12511500 / var1463.dms / var1463.adf / BBBBS72.lha / rexx / BBBBS.baud < prev    next >
Text File  |  1994-04-16  |  211KB  |  7,671 lines
  1. /*               $VER: BBBBS.baud 7.2 (16.4.94)
  2.  BBBBS.baud 7.2 © 1990-94 Richard Lee Stockton 16 Apr 94 11:47PM
  3.      - FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -
  4.   
  5.      BBBBS.baud. A full-featured BBS in ARexx for Baudbandit
  6. based on 'Answer.baud'. Thanks to Greg Cunningham for BaudBandit!
  7.  See Information/BBBBS.doc & rexx/bbsLOCAL.rexx for install info
  8. */
  9.  
  10. saypath='SYS:Utilities/Say'
  11. copyright.=''
  12. copyright.1=STRIP(SOURCELINE(2))
  13. copyright.2='
  14. Gramma Software 21305-60th Ave West, Mountlake Terrace WA 98043-2009'
  15. copyright.3='
  16. ARexx portions of this software copyright 1990-93 Richard Lee Stockton'
  17. copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -'
  18.  
  19. /* If QuickSortPort not found then try to run setup.rexx */
  20.  
  21. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  22. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  23.  
  24. IF SHOW('P','BBBBS') THEN
  25.   DO
  26.     SAY 'BBBBS is already running!'
  27.     EXIT 0
  28.   END
  29. CALL OPENPORT('BBBBS')
  30.  
  31. CALL SETCLIP('BBS_version',copyright.1)
  32. CALL SETCLIP('BBS_localfiles')
  33. CALL SETCLIP('BBS_localusers')
  34. CALL SETCLIP('BBS_interpret')
  35. CALL SETCLIP('BBS_maint')
  36. CALL SETCLIP('BBS_MESSAGE')
  37. CALL SETCLIP('BBS_BROWSE')
  38. CALL SETCLIP('BBS_MSGS')
  39. CALL SETCLIP('BBS_QUIT')
  40.  
  41. /* try to trap everything */
  42.  
  43. OPTIONS RESULTS
  44. OPTIONS FAILAT 999999
  45. NUMERIC DIGITS 14
  46. SIGNAL ON HALT
  47. SIGNAL ON SYNTAX
  48. SIGNAL ON FAILURE
  49. SIGNAL OFF BREAK_C
  50. SIGNAL OFF BREAK_E
  51.  
  52. PARSE VERSION . . cpu .
  53. cpu=RIGHT(cpu,2)/10
  54. IF cpu<1 THEN cpu=1
  55. Status Vers
  56. BB_VERS=RESULT
  57. bm=50
  58. IF RIGHT(BB_VERS,4)>1.59 THEN bm=25
  59.  
  60. dcd
  61. IF RC=0 THEN Send 'ATH1\r'
  62.  
  63. bbsprefs.=0  /* start with all prefs OFF */
  64. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  65. alpha.=''
  66. logonflag=1
  67. emailonline=-1
  68. CALL zerovars()
  69.  
  70.  
  71. /* User data structure by line */
  72.  
  73. text.=''
  74. text.1='   Full Name'
  75. text.2='      Street'
  76. text.3='City, ST Zip'
  77. text.4=' Voice Phone'
  78. text.5='    Password'
  79. text.6='    Protocol'
  80. text.7='LinesPerPage'
  81. text.8=' Preferences'
  82. text.9='    Computer'
  83. text.10='   Interests'
  84. text.11='Session Time'
  85. text.12='FirstSession'
  86. text.13='Last Session'
  87. text.14='      UpLoad'
  88. text.15='    Download'
  89. text.16='   Last File'
  90. text.17='Ratio  Email'
  91. text.18='    Winnings'
  92. text.19='       Usage'
  93. text.20='       Level'
  94. text.21='Exclude DIRS'
  95. text.22='   Msgs Read'
  96. text.23='   Msgs Writ'
  97. text.24=' Marked Msgs'
  98. text.25='Marked Files'
  99. text.26='QUICKexclude'
  100. text.27=' CBV numbers'
  101.  
  102.  
  103. name=''
  104. CR='0D'x
  105. LF='0A'x
  106.  
  107. SAY CR
  108. SAY CENTER(copyright.1,75)||CR
  109.  
  110. CALL PRAGMA('W','N')
  111. CALL config()
  112. IF bbsprefs.15~=0 THEN
  113.   CALL send2log('===== BBBBS started' DATE('W') DATE() TIME('C') '=====')
  114.  
  115. IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN
  116.   ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon'
  117.  
  118. SAY CENTER(copyright.2,75)||CR
  119.  
  120. /* open printer? */
  121. IF bbsprefs.3 THEN
  122.   DO
  123.     IF ~OPEN(p,'PRT:','W') THEN
  124.       DO
  125.         CALL send2log('failed to open printer.')
  126.         bbsprefs.3=0
  127.       END
  128.   END
  129.  
  130. /* CALL PRAGMA('W','W')   <-- UN-COMMENT THIS LINE TO ENABLE REQUESTERS */
  131. CALL colors(1)
  132. Capture OFF
  133. Timeout 120
  134. SAY CENTER(copyright.3,75)||CR
  135.  
  136. excuses.=''
  137. courtesy=''
  138. courtesyflag=0
  139. SAY CENTER(copyright.4,75)||CR
  140. SAY CR
  141. SAY CR
  142. SAY '                      Setting up, please wait...'CR
  143. SAY CR
  144.  
  145. msg.=''
  146. IF readopen(bbspath'Lists/Conferences') THEN
  147.   DO
  148.     DO i=1
  149.       line=READLN(f)
  150.       IF line='END' THEN BREAK
  151.       IF EOF(f) THEN BREAK
  152.       num=WORD(line,1)
  153.       IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
  154.     END
  155.     CALL CLOSE(f)
  156.   END
  157.  
  158. dirs.=''
  159. IF readopen(bbspath'Lists/Libraries') THEN
  160.   DO
  161.     DO i=1
  162.       line=READLN(f)
  163.       IF line='END' | EOF(f) THEN LEAVE i
  164.       num=WORD(line,1)
  165.       IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2))
  166.     END
  167.     CALL CLOSE(f)
  168.   END
  169. CALL loaduserlist()
  170. SAY CR
  171. SAY '          The larger the BBS gets, the longer it takes to setup...'CR
  172. CALL loadfiles()
  173. dcd
  174. IF RC~=0 THEN
  175.   DO
  176.     SAY CR
  177.     SAY '      If it seems to take forever, ask the sysop to try' pen3'Resident'def 'mode.'CR
  178.   END
  179. SAY CR
  180. CALL set_grand()
  181. CALL loadalpha()
  182.  
  183. dcd
  184. IF RC=0 THEN
  185.   DO
  186.     logonflag=0
  187.     SIGNAL DONE
  188.   END
  189.  
  190. LOGON:
  191. CALL checkdcd()
  192. bps=0
  193. SetMark 'CONNECT'
  194. IF RC=1 THEN
  195.   DO
  196.     GetLine
  197.     connectline=RESULT
  198.     PARSE VAR connectline 'CONNECT'bps
  199.     CALL STRIP(bps)
  200.     DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
  201.     END
  202.     bps=LEFT(bps,i-1)
  203.   END
  204. IF bps<300 | bps>38400 THEN
  205.   DO
  206.     SetMark 'CARRIER'
  207.     IF RC=1 THEN
  208.       DO
  209.         GetLine
  210.         connectline=RESULT
  211.         PARSE VAR connectline 'CARRIER'bps
  212.         CALL STRIP(bps)
  213.       END
  214.     ELSE bps='000 '
  215.   END
  216. DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
  217. END
  218. bps=LEFT(bps,i-1)
  219. SIGNAL ON BREAK_C
  220. SIGNAL OFF BREAK_E
  221. REMOTE ON
  222. TimeOut 120
  223. IF bps<300 THEN bps=getbaudrate()
  224. IF bps>16800 THEN bps=getinput(1 0 'Please enter your modem to modem baudrate > ')
  225. IF bps<300 THEN SIGNAL DONE
  226. bps=bps%1
  227. IF logonflag=0 THEN
  228.   DO
  229.     logonflag=1
  230.     DO i=1 TO 7
  231.       SAY '  'CR
  232.     END
  233.     DO i=1 TO 4
  234.       SAY CENTER(copyright.i,75)||CR
  235.     END
  236.     CALL sound('LOGON')
  237.     CALL DELAY(150)
  238.     CALL colors(1)
  239.     SAY CR
  240.     SAY CR
  241.     SAY CR
  242.   END
  243.  
  244. IF alpha.0='' THEN CALL loadalpha()
  245.  
  246. CALL TIME('R')
  247.  
  248. /** Identify (title) message */
  249. IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
  250.   DO
  251.     nonstop=1
  252.     arg=bbspath'BBS_TEXT/HELLO'
  253.     CALL readlines(arg 1)
  254.     CALL seelines(0)
  255.     nonstop=0
  256.   END
  257. SAY CR
  258.  
  259. SAY 'Running on' BB_VERS 'at' bps 'baud. ' TIME('C') DATE('W') DATE()||CR
  260. Stat 'Z'
  261. CALL checkdcd()
  262.  
  263. /* Ask for name */
  264. name=''
  265. courtesy=''
  266. Queue CR
  267. DO count=1 TO 3
  268.   name=getinput(1 0 'Please enter name: ')
  269.   name=cleanstring(1':'name)
  270.   IF name='NEW' THEN LEAVE count
  271.   IF name~='' THEN
  272.     DO
  273.       IF FIND(userlist,name)>0 THEN LEAVE count
  274.       IF FIND(exclusion,name)>0 THEN
  275.         DO
  276.           SAY 'Sorry, that is a reserved name.'CR
  277.           name=''
  278.           ITERATE count
  279.         END
  280.       CALL loadcourtesy()
  281.       IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN
  282.         DO
  283.           SAY CR
  284.           SAY 'Welcome' name'!'CR
  285.           SAY 'You will be automatically validated after you enter your user info.'CR
  286.           SAY CR
  287.           LEAVE count
  288.         END
  289.     END
  290.   IF count<3 THEN
  291.     DO
  292.       IF STRIP(name)~='' THEN SAY name 'not found.  Please try again.'CR
  293.       SAY 'New Users enter NEW to apply for validation.'CR
  294.     END
  295. END
  296. IF count>3 THEN SIGNAL DONE
  297. CALL TIME('R')
  298. logontime=TIME('C')
  299. line=left(name,16,' ') 'logged in  at' time('C') date('W') date() 'at' bps 'baud'
  300. CALL send2log(line)
  301. CALL checkUser()
  302. IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN
  303.   DO
  304.     SAY CR
  305.     SAY 'Please help us out by entering the following information.'CR
  306.     CALL getbirth()
  307.     SAY '   Thank you!'CR
  308.   END
  309. prevcaller=''
  310. prevcaller=GETCLIP('BBS_lastcaller')
  311. IF prevcaller~='' THEN CALL SETCLIP('BBS_prevcaller',prevcaller)
  312. city=docity(data.3)
  313. CALL SETCLIP('BBS_lastcaller',name city'  'TIME('C') DATE())
  314. CALL SETCLIP('BBS_level',level)
  315. CALL postuser(0)
  316. Timeout maxidle         /* max idle time at prompts */
  317.  
  318. IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN
  319.   DO
  320.     arg=bbspath'BBS_TEXT/BIRTHDAY'
  321.     IF EXISTS(arg) THEN 
  322.       DO
  323.         SAY CR
  324.         CALL showtext(arg)
  325.       END
  326.     SAY CR
  327.     SAY '***  Happy Birthday,' pen3||data.1||def', and many more!  ***'CR
  328.   END
  329. SAY CR
  330.  
  331. /* Get current protocol */
  332. Status Trans
  333. protocol=STRIP(RESULT)
  334.  
  335. IF bbsLOGON.baud(name level)=1 THEN SIGNAL OUT
  336. CALL checkdcd()
  337. CALL sortlibraries()
  338. IF FIND(data.8,'QUICK')>0 THEN
  339.   DO
  340.     logonflag=0
  341.     CALL do_quick(0)
  342.     logonflag=1
  343.   END
  344.  
  345. /*
  346. Opening Display after logon. Seen by all Users ONCE A DAY. It first
  347. looks for a unique yearly data (ie, WELCOME.0704), then daily data
  348. (ie, WELCOME.Fri), and then a simple, everyday 'WELCOME' datafile.
  349. */
  350.  
  351. IF DATE('I')>lastondate THEN
  352.   DO
  353.     SAY CR
  354.     arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
  355.     IF EXISTS(arg) THEN CALL showtext(arg)
  356.     SAY CR
  357.     arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
  358.     IF EXISTS(arg) THEN CALL showtext(arg)
  359.     SAY CR
  360.     arg=bbspath'BBS_TEXT/WELCOME'
  361.     IF EXISTS(arg) THEN CALL showtext(arg)
  362.  
  363. /*
  364. Looks for files in the format BAUD.baudrate, ie "BAUD.2400" will only
  365. be seen by users logging on at 2400 baud.
  366. */
  367.  
  368.     arg=bbspath'BBS_TEXT/BAUD.'bps
  369.     IF EXISTS(arg) THEN
  370.       DO
  371.         SAY CR
  372.         CALL showtext(arg)
  373.       END
  374.  
  375. /*
  376. Looks for files in the format  LEVEL.low-high, ie "LEVEL.50-80" will only
  377. be seen by users with a level >= 50 and <= 80.
  378. */
  379.  
  380.     levels.=''
  381.     IF FileList(bbspath'BBS_TEXT/LEVEL.*',levels)>0 THEN
  382.       DO
  383.         DO ui=1 TO levels.0
  384.           p=LASTPOS('.',levels.ui)
  385.           x=SUBSTR(levels.ui,p+1)
  386.           PARSE VAR x lo'-'hi .
  387.           IF ~DATATYPE(lo,'W') | ~DATATYPE(hi,'W') THEN ITERATE ui
  388.           IF lo>level | hi<level THEN ITERATE ui
  389.           DO
  390.             SAY CR
  391.             CALL showtext(levels.ui)
  392.           END
  393.         END
  394.       END
  395.  
  396. /*
  397. Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514"
  398. Deletes any that are previous to "today"
  399. */
  400.  
  401.     untils.=''
  402.     IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
  403.       DO
  404.         CALL QSORT(1,untils.0,untils)
  405.         DO ui=1 TO untils.0
  406.           IF RIGHT(untils.ui,8)<DATE('S') THEN CALL DELETE(untils.ui)
  407.           ELSE
  408.             DO
  409.               SAY CR
  410.               CALL showtext(untils.ui)
  411.             END
  412.         END
  413.       END
  414.     DROP levels. untils.
  415.   END
  416.  
  417. IF bbsprefs.1 & ~terseflag THEN
  418.   DO
  419.     IF doGrin()>3 THEN CALL waiting()
  420.     IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx()
  421.     IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx()
  422.     IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN
  423.       DO
  424.         IF EXISTS('RAM:TODAY') THEN
  425.           DO
  426.             finfo=STATEF('RAM:TODAY')
  427.             IF WORD(finfo,5)~=DATE('I') THEN
  428.               ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
  429.           END
  430.         ELSE ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
  431.         IF EXISTS('RAM:TODAY') THEN
  432.           DO
  433.             CALL readlines('RAM:TODAY' 1)
  434.             CALL seelines(0)
  435.           END
  436.       END
  437.     SAY CR
  438.   END
  439.  
  440. CALL readmail(0)
  441. IF ~terseflag THEN
  442.   DO
  443.     IF level>sysoplevel THEN
  444.       DO
  445.         lstmail=WORD(data.17,3)
  446.         IF ~DATATYPE(lstmail,'W') THEN lstmail=0
  447.         IF countcheck(bbspath'Numbers/LastMail' 0)>lstmail THEN
  448.           IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport()
  449.         IF level<99 THEN
  450.           DO
  451.             SAY CR
  452.             CALL showtext(bbspath'Email/'sysop'/NEW_FILES')
  453.           END
  454.         SAY CR
  455.         CALL showtext(bbspath'Lists/NEW_USERS')
  456.         CALL showtext(bbspath'Lists/CBV_USERS')
  457.       END
  458.     CALL logonstats()
  459.     CALL newinfo()
  460.   END
  461. CALL showmarked(1)
  462. CALL setdir(libpath||dirs.1)
  463. logonflag=0
  464.  
  465.  
  466. /***** MAIN *****/
  467.  
  468. IF menu~='ALL' THEN menu='MAIN'
  469.  
  470. RESTART:
  471. IF name='' | data.20='' | logonflag THEN SIGNAL LOGON  /* login was interrupted */
  472. SIGNAL ON BREAK_C
  473. SIGNAL ON BREAK_E
  474.  
  475. waitchar=''
  476. string=''
  477. opt=''
  478. IF level<1 THEN menu='NEW'
  479. DO WHILE(opt~='G')
  480.   go=0
  481.   DO WHILE(~go)
  482.     IF waitchar='' | waitchar='?' THEN
  483.       DO
  484.         commands='cghiqrsvwxyz!#,'
  485.         IF level>0  THEN commands='abcdefghijlmnoprstuvwxyz!$#&+,.'
  486.         IF level>sysoplevel THEN commands=commands'k%^()=;'
  487.         IF level=99 THEN commands=commands'@~'
  488.         commands=commands'?'
  489.         IF menuflag | waitchar='?' | string='?' THEN CALL menus()
  490.         ELSE SAY pen3'COMMANDS:'def commands||CR
  491.         opt='MENU'
  492.         arg=''
  493.         CALL postuser(1)
  494.       END
  495.     CALL showtime()
  496.     line=''
  497.     line=line||bak2' 'TIME('C')' 'def
  498.     IF menu='ALL' | menu='FILE' THEN
  499.       line=line pen3'FILE_LIBRARY:'plaindir||def
  500.     ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
  501.     ELSE line=line pen3'MAIN:'def
  502.     line=line'  'bbsname
  503.     IF waitchar='' THEN waitchar=getinput(0 0 line' > ')
  504.     PARSE VAR waitchar string' 'arg
  505.     CALL checkdcd()
  506.     nonstop=0
  507.     string=UPPER(STRIP(string))
  508.     IF clr~='' THEN Send clr
  509.     IF POS('+++',string)>0 THEN SIGNAL OUT
  510.     IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT2
  511.     IF string='FL' & level>0 THEN CALL Friends()
  512.     CALL checkalias()
  513.     waitchar=''
  514.     warnings=0
  515.     IF DATATYPE(string,'W') THEN
  516.       DO
  517.         IF string>level THEN
  518.           DO
  519.             arg=STRIP(string arg)
  520.             string='D'
  521.           END
  522.         ELSE
  523.           DO
  524.             dirnum=string
  525.             CALL chdir2()
  526.             CALL since()
  527.           END
  528.       END
  529.     IF string='QUICK' & level>0 THEN CALL do_quick(1)
  530.     opt=left(string,1)
  531.     IF opt='G' THEN
  532.       DO
  533.         IF getinput(1 1 pen3'Logoff? (nY) > 'def)='N' THEN opt='?'
  534.       END
  535.     go=1    /* check for access */
  536.     IF POS(opt,UPPER(commands))=0 THEN go=0
  537.   END
  538.   IF CBVflag=1 THEN SIGNAL OUT
  539.   CALL postuser(1)
  540.   OPTIONS PROMPT 'Filename: '
  541.   SELECT
  542.     WHEN opt='A' THEN CALL showalpha()
  543.     WHEN opt='B' THEN CALL browse()
  544.     WHEN opt='C' THEN CALL editor('MAIL' sysop)
  545.     WHEN opt='D' THEN CALL dload()
  546.     WHEN opt='E' THEN CALL readmail(1)
  547.     WHEN opt='F' THEN CALL do_F()
  548.     WHEN opt='H' THEN CALL help('MAIN')
  549.     WHEN opt='I' THEN CALL information()
  550.     WHEN opt='J' THEN CALL jump2rexx()
  551.     WHEN opt='K' THEN CALL killuser()
  552.     WHEN opt='L' THEN CALL list()
  553.     WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG'
  554.     WHEN opt='N' THEN CALL newfiles()
  555.     WHEN opt='O' THEN CALL otheruser()
  556.     WHEN opt='P' THEN CALL editor('MSG')
  557.     WHEN opt='R' THEN IF menu='NEW' THEN CALL CBV();ELSE CALL readmessages()
  558.     WHEN opt='S' THEN CALL bbsSEARCH()
  559.     WHEN opt='T' THEN CALL chpro()
  560.     WHEN opt='U' THEN CALL uload(1)
  561.     WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG')
  562.     WHEN opt='W' THEN CALL showuserlist()
  563.     WHEN opt='X' THEN CALL switchmenuflag()
  564.     WHEN opt='Y' THEN CALL edituser()
  565.     WHEN opt='Z' THEN CALL counts()
  566.     WHEN opt='~' THEN CALL sysED(1)
  567.     WHEN opt='!' THEN CALL yell()
  568.     WHEN opt='@' THEN CALL shell()
  569.     WHEN opt='#' THEN CALL switchcolors()
  570.     WHEN opt='$' THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
  571.     WHEN opt='%' THEN CALL editnote()
  572.     WHEN opt='^' THEN CALL readlogs()
  573.     WHEN opt='&' THEN CALL profiles(1)
  574.     WHEN opt='+' THEN CALL ext_dload()
  575.     WHEN opt='(' THEN CALL filereport()
  576.     WHEN opt=')' THEN CALL mailreport()
  577.     WHEN opt='=' THEN CALL levelreport()
  578.     WHEN opt=';' THEN CALL changename()
  579.     WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END
  580.     WHEN opt='.' THEN IF menu~='ALL' THEN menu='MAIN'
  581.     WHEN opt='?' THEN IF menuflag THEN CALL help('MAIN')
  582.     OTHERWISE NOP
  583.   END
  584. END
  585. SIGNAL LOGOUT
  586. EXIT
  587.  
  588.  
  589.  
  590. /* FUNCTIONS */
  591.  
  592.  
  593. do_F:
  594. IF menu='FILE' | menu='ALL' THEN
  595.   DO
  596.     IF STORAGE()<(bbsprefs.15+100000) | GETCLIP('BBS_libs.0')~='' THEN
  597.       DO
  598.         SAY CR
  599.         SAY 'Sorry! Not enough memory left for background archiving.'CR
  600.         SAY 'Please try again in 10 minutes or so.'CR
  601.         SAY CR
  602.         RETURN
  603.       END
  604.     DO i=0 TO libs.0
  605.       CALL SETCLIP('BBS_libs.'i,libs.i)
  606.     END
  607.     IF Make_BrowseList.baud(name colorflag files.0)=0 THEN
  608.       DO
  609.         CALL send2log('Arc: Make_BrowseList.baud')
  610.         IF emailonline>=0 THEN emailonline=emailonline+1
  611.       END
  612.     DO i=0 TO libs.0
  613.       CALL SETCLIP('BBS_libs.'i)
  614.     END
  615.   END
  616. ELSE IF menu~='ALL' THEN menu='FILE'
  617. RETURN
  618.  
  619.  
  620. cleanstring:
  621. PARSE ARG nflag':'cstr
  622. IF nflag=1 THEN
  623.   DO
  624.     cstr=COMPRESS(cstr,"'`")
  625.     cstr=TRANSLATE(cstr,,namemask)
  626.     cstr=SPACE(cstr,1,'_')
  627.     RETURN cstr
  628.   END
  629. bot=XRANGE(,'1F'x)
  630. bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
  631. top=XRANGE('7F'x)
  632. cstr=COMPRESS(cstr,bot||top)
  633. IF nflag=0 THEN cstr=STRIP(cstr)
  634. RETURN cstr
  635.  
  636.  
  637. showtext:
  638. PARSE ARG arg .
  639. IF EXISTS(arg) THEN
  640.   DO
  641.     CALL readlines(arg 1)
  642.     CALL seelines(1)
  643.     nonstop=0
  644.     CALL waiting()
  645.   END
  646. RETURN
  647.  
  648.  
  649. doGrin:
  650. IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0
  651. CALL setdir(bbspath'rexxDoors')
  652. temp=Grin_du_Jour.rexx()
  653. SAY CR
  654. RETURN temp
  655.  
  656.  
  657. send2log:
  658. PARSE ARG sendline
  659. logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
  660. IF ~OPEN('log',logfile,'A') THEN
  661.   DO
  662.     IF ~OPEN('log',logfile,'W') THEN
  663.       DO
  664.         SAY 'failed to open log file'
  665.         SIGNAL DONE
  666.      END
  667.   END
  668. CALL WRITELN('log',sendline)
  669. CALL CLOSE('log')
  670. IF bbsprefs.3=1 THEN CALL WRITELN(p,sendline)
  671. RETURN
  672.  
  673.  
  674. send2last:
  675. PARSE ARG sendline
  676. IF bbsprefs.24~=1 & name=sysop THEN RETURN
  677. lynes.=''
  678. lynes.0=2
  679. lynes.1='        -'pen3 bbsname def'user log for the last 99 calls -'
  680. lynes.2=sendline
  681. logfile=bbspath'USAGE/USER.LOG'  /* simple usage log */
  682. IF EXISTS(logfile) THEN
  683.   DO
  684.     x=OPEN(lu,logfile,'R')
  685.     IF x=0 THEN RETURN
  686.     CALL READLN(lu)
  687.     DO i=3 TO 99
  688.       sendline=READLN(lu)
  689.       IF EOF(lu) THEN LEAVE i
  690.       lynes.i=sendline
  691.     END
  692.     CALL CLOSE(lu)
  693.     CALL DELAY(28)
  694.     IF i>99 THEN lynes.0=99
  695.     ELSE lynes.0=i-1
  696.   END
  697. x=OPEN(lu,logfile,'W')
  698. IF x=0 THEN RETURN
  699. DO i=1 TO lynes.0
  700.   CALL WRITELN(lu,lynes.i)
  701. END
  702. CALL CLOSE(lu)
  703. RETURN
  704.  
  705.  
  706. do_quick:
  707. ARG flag .
  708. IF FIND(UPPER(data.8),'QUICK')=0 THEN
  709.   DO
  710.     SAY CR
  711.     SAY 'The QUICK option is OFF in your current settings.'CR
  712.     SAY CR
  713.     SAY 'Setting the QUICK option to ON will allow you to tell the BBS to'CR
  714.     SAY 'make a .lha archive of all new bbs activity since your last call.'CR
  715.     SAY CR
  716.     SAY 'This archive can then be read (and replied to, and files can be'CR
  717.     SAY 'uploaded and downloaded) using 'pen3'bbsQUICK.rexx'def', the offline read/reply'CR
  718.     SAY 'module for BBBBS, which is available here in the file libraries.'CR
  719.     SAY CR
  720.     IF getinput(1 1 'Turn the QUICK option ON? (Ny) >')~='Y' THEN RETURN
  721.     data.8=data.8 'QUICK'
  722.     CALL saveData(0)
  723.   END
  724. ELSE IF flag=1 THEN
  725.   DO
  726.     IF getinput(1 1 'Turn the QUICK option OFF? (Ny) > ')='Y' THEN
  727.       DO 
  728.         temp=data.8
  729.         data.8=''
  730.         DO i=1 TO WORDS(temp)
  731.           IF WORD(temp,i)~='QUICK' THEN data.8=STRIP(data.8 WORD(temp,i))
  732.         END
  733.         ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/QUICK_#?'
  734.         RETURN
  735.       END
  736.   END
  737. IF getinput(1 1 'Edit your QUICK exclude list? (Ny) > ')='Y' THEN
  738.   DO
  739.     SAY CR
  740.     SAY 'You may EXCLUDE any of these from your QUICK archives.'CR
  741.     SAY pen3||LEFT('-',74,'-')||def||CR
  742.     temp=LEFT(' ',7)
  743.     SAY temp'HELLO          - Pre-logon message.'CR
  744.     SAY temp'WELCOME        - Post-logon message.'CR
  745.     SAY temp'GOODBYE        - Logoff message.'CR
  746.     SAY temp'HOURLY         - Average-Minutes-Per-Hour usage graph.'CR
  747.     SAY temp'STATS.BBS      - Most of the Z command from the main menu.'CR
  748.     SAY temp'filename       - ANY filename in the Information area.'CR
  749.     SAY temp'MESSAGES       - New conference messages.'CR
  750.     SAY temp'FILELIST       - New file descriptions.'CR
  751.     SAY pen3||LEFT('-',74,'-')||def||CR
  752.     SAY 'Enter a space separated list of what you wish to exclude.'CR
  753.     SAY pen3'Exclude:'def data.26||CR
  754.     temp=getinput(1 0 pen3'Exclude: 'def)
  755.     IF temp='' & data.26~='' THEN
  756.       DO
  757.         IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN
  758.           data.26=''
  759.       END
  760.     ELSE data.26=temp
  761.     temp='Your QUICK archives will exclude'pen3
  762.     IF data.26='' THEN temp=temp 'nothing!'
  763.     ELSE temp=temp data.26
  764.     SAY temp||def||CR
  765.     CALL saveData(0)
  766.     SAY CR
  767.   END
  768. IF GETCLIP('BBS_'name)~='' THEN
  769.   DO
  770.     SAY CR
  771.     SAY 'The QUICK routines are still working on your archive...'CR
  772.     SAY 'Please try again later.'CR
  773.     SAY CR
  774.     RETURN
  775.   END
  776. quickdir=bbspath'EmailFiles/'name
  777. CALL MAKEDIR(quickdir)
  778. CALL setdir(quickdir)
  779. IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) > ')='Y' THEN
  780.   DO
  781.     arg='QUICKIN.lha'
  782.     ul=2
  783.     DO WHILE ul=2
  784.       ul=uload(0)
  785.     END
  786.   END
  787. IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN
  788.   IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN
  789.     DO
  790.       ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
  791.       SAY CR
  792.       SAY 'Processing QUICKIN archive...'CR
  793.       SAY CR
  794.     END
  795. IF GETCLIP('BBS_'name)='QUICK' THEN
  796.   DO
  797.     SAY CR
  798.     SAY 'The QUICK routines are still working on your file(s)...'CR
  799.     SAY CR
  800.     RETURN
  801.   END
  802. arg='RAM:dirlist'
  803. ADDRESS COMMAND 'C:list >'arg quickdir'/QUICK_#? DATES'
  804. IF WORD(STATEF(arg),2)>80 THEN
  805.   DO
  806.     CALL readlines(arg 1)
  807.     CALL seelines(0)
  808.     SAY CR
  809.   END
  810. efiles=UPPER(SHOWDIR(quickdir))
  811. DO qi=1 TO WORDS(efiles)
  812.   qarg=WORD(efiles,qi)
  813.   IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN
  814.     DO
  815.       SAY qarg 'is' WORD(STATEF(qarg),2) 'bytes.'CR
  816.       allargs=qarg
  817.       DO WHILE dload2()=1
  818.       END
  819.       t=''
  820.       DO WHILE t~='N' & t~='Y'
  821.         t=getinput(1 1 'Delete' qarg'? (ny) > ')
  822.       END
  823.       IF t='Y' THEN
  824.         DO
  825.           IF DELETE(quickdir'/'qarg)=1 THEN SAY qarg 'deleted.'CR
  826.           CALL DELETE(quickdir'/'qarg'.xdl')
  827.           qarg=COMPRESS(UPPER(qarg),'QUICK_.LHA')
  828.           CALL DELETE(bbspath'Email/'name'/BBBBS.'qarg)
  829.         END
  830.     END
  831. END
  832. arg=''
  833. SAY CR
  834. IF GETCLIP('BBS_'name)~='' THEN RETURN
  835. IF getinput(1 1 'Archive new BBS activity now? (Ny) > ')='Y' THEN
  836.   DO
  837.     CALL SETCLIP('BBS_city',city)
  838.     CALL SETCLIP('BBS_'name'_26',data.26)
  839.     IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN
  840.       CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0)
  841.     IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
  842.       CALL SETCLIP('BBS_'name'_22',data.22)
  843.     CALL MAKEDIR(bbspath'EmailFiles/'name)
  844.     CALL showmarked(0)
  845.     CALL SETCLIP('BBS_QUICKOUT_BAUD',bps)
  846.     ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21
  847.     CALL send2log('Started QUICKOUT at' TIME('C'))
  848.     SAY CR
  849.     IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
  850.       DO
  851.         clear_marked=1
  852.         DO i=1 TO level
  853.           IF WORD(data.22,i)~=-1 THEN
  854.             lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
  855.         END
  856.         SAY CR
  857.       END
  858.     IF FIND(UPPER(data.26),'FILELIST')=0 THEN
  859.       lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
  860.     newfilesdate=DATE('S') TIME()
  861.     IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN
  862.       DO
  863.         DO i=1 TO libs.0
  864.           CALL WRITELN(f,libs.i)
  865.         END
  866.         CALL CLOSE(f)
  867.       END
  868.     IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN
  869.       DO
  870.         DO i=1 TO msgs.0
  871.           CALL WRITELN(f,msgs.i)
  872.         END
  873.         CALL CLOSE(f)
  874.       END
  875.     SAY CR
  876.     IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN
  877.       DO
  878.         SAY 'Your archive will be waiting next time you call...'CR
  879.         SAY CR
  880.         SIGNAL LOGOUT2
  881.       END
  882.     SAY CR
  883.     SAY 'Note: You now have no ''new'' files or messages (they are being archived).'CR
  884.     SAY CR
  885.     SAY 'You will be signaled if you are still online when your archive is ready...'CR
  886.     SAY CR
  887.     CALL saveData(1)
  888.     CALL waiting()
  889.   END
  890. ELSE
  891.   DO
  892.     SAY CR
  893.     IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN SIGNAL LOGOUT2
  894.   END
  895. SAY CR
  896. CALL setdir(libpath||dirs.1)
  897. RETURN
  898.  
  899.  
  900. killuser:
  901. IF level<=sysoplevel THEN RETURN
  902. killcount=0
  903. DO loop=1
  904.   IF arg='' THEN
  905.     DO
  906.       OPTIONS PROMPT 'RETURN=QUIT  Username to Kill: '
  907.       PULL arg
  908.     END
  909.   IF STRIP(arg)='' THEN LEAVE loop
  910.   arg=UPPER(arg)
  911.   arg=SPACE(STRIP(arg),1,'_')
  912.   IF getinput(1 1 'Really kill' arg'? (nY) > ')='N' THEN
  913.     DO
  914.       arg=''
  915.       ITERATE loop
  916.     END
  917.   SAY 'Working...'lineup||CR
  918.   IF readlines(bbspath'Users/'arg 1) THEN
  919.     DO
  920.       SAY 'User' arg 'not found.'CR
  921.       arg=''
  922.       ITERATE loop
  923.     END
  924.   IF level<=lynes.20 THEN
  925.     DO
  926.       SAY '*** Tsk! Tsk!  Your level is not greater than' arg'.'CR
  927.       CALL send2log('Tried to kill:' arg)
  928.       arg=''
  929.       ITERATE loop
  930.     END
  931.   CALL DELETE(bbspath'Users/'arg)
  932.   IF EXISTS(bbspath'Email/'arg) THEN
  933.     DO
  934.       temp=WORDS(SHOWDIR(bbspath'Email/'arg))
  935.       emailonline=emailonline-temp
  936.       ADDRESS COMMAND 'C:DELETE >*' bbspath'Email/'arg 'ALL'
  937.     END
  938.   IF EXISTS(bbspath'EmailFiles/'arg) THEN
  939.     ADDRESS COMMAND 'C:DELETE >*' bbspath'EmailFiles/'arg 'ALL'
  940.   CALL send2log('Killed:' arg)
  941.   SAY CR'User file, Email & EmailFiles for' arg 'have been deleted.'CR
  942.   killcount=killcount+1
  943.   arg=''
  944. END
  945. IF killcount=0 THEN RETURN
  946. CALL DELETE(bbspath'Lists/USERS')
  947. sortuserflag=1
  948. RETURN
  949.  
  950.  
  951. menus:
  952. CALL checkdcd()
  953. IF menu='NEW' THEN
  954.   DO
  955.     SAY pen6'     _________________'def||CR
  956.     SAY pen6'  __/  'pen3'New User Menu'pen6'  \___'def||CR
  957.     SAY pen6' |                        |'def||CR
  958.     SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
  959.     SAY pen6' |'def'   ['pen3'I'def']nformation        'pen6'|'def||CR
  960.     SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
  961.     SAY pen6' |'def'   ['pen3'W'def']ho is here        'pen6'|'def||CR
  962.     SAY pen6' |'def'   ['pen3'S'def']earch user list   'pen6'|'def||CR
  963.     SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
  964.     SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
  965.     SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
  966.     SAY pen6' |'def'   ['pen3'X'def'] toggle menus     'pen6'|'def||CR
  967.     SAY pen6' |'def'   ['pen3'#'def'] toggle color     'pen6'|'def||CR
  968.     SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
  969.     SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
  970.     SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
  971.     SAY pen6' |________________________|'def||CR
  972.     IF bbsprefs.22~=0 THEN
  973.       DO
  974.         SAY CR
  975.         SAY 'Local Callers may register and receive' pen7'INSTANT VALIDATION'def'!'CR
  976.         SAY 'Enter R to ['pen3'R'def']egister using Call Back Verify.'CR
  977.       END
  978.   END
  979. ELSE IF menu='MSG' THEN
  980.   DO
  981.     SAY pen6'       ____________'def||CR
  982.     SAY pen6'  ____/  'pen3'Messages'pen6'  \_____'def||CR
  983.     SAY pen6' |                       |'def||CR
  984.     SAY pen6' |'def'   ['pen3'H'def']elp              'pen6'|'def||CR
  985.     SAY pen6' |'def'   ['pen3'P'def']ost messages     'pen6'|'def||CR
  986.     SAY pen6' |'def'   ['pen3'R'def']ead messages     'pen6'|'def||CR
  987.     SAY pen6' |'def'   ['pen3'S'def']earch messages   'pen6'|'def||CR
  988.     SAY pen6' |'def'   ['pen3'E'def']mail (private)   'pen6'|'def||CR
  989.     SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP  'pen6'|'def||CR
  990.     SAY pen6' |'def'   ['pen3'QUICK'def'] options     'pen6'|'def||CR
  991.     SAY pen6' |'def'   ['pen3'FL'def'] Friends List   'pen6'|'def||CR
  992.     SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP  'pen6'|'def||CR
  993. IF(level>sysoplevel) THEN DO
  994.     SAY pen6' |'def'   ['pen3'^'def'] view BBS logs   'pen6'|'def||CR
  995.     SAY pen6' |'def'   ['pen3')'def'] email report    'pen6'|'def||CR
  996.     SAY pen6' |'def'   ['pen3'='def'] level report    'pen6'|'def||CR
  997.     SAY pen6' |'def'   ['pen3';'def'] change username 'pen6'|'def||CR;END
  998. IF(level=99) THEN DO
  999.     SAY pen6' |'def'   ['pen3'~'def'] online editor   'pen6'|'def||CR
  1000.     SAY pen6' |'def'   ['pen3'@'def'] dos shell       'pen6'|'def||CR;END
  1001.     SAY pen6' |'def'   ['pen3'F'def']iles menu        'pen6'|'def||CR
  1002.     SAY pen6' |'def'   ['pen3'.'def'] main menu       'pen6'|'def||CR
  1003.     SAY pen6' |_______________________|'def||CR
  1004.   END
  1005. ELSE IF menu='FILE' THEN
  1006.   DO
  1007.     SAY pen6'         _________'def||CR
  1008.     SAY pen6'  ______/  'pen3'Files'pen6'  \_______'def||CR
  1009.     SAY pen6' |                        |'def||CR
  1010.     SAY pen6' |'def'   ['pen3'A'def']lphabetic list    'pen6'|'def||CR
  1011.     SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
  1012.     SAY pen6' |'def'   ['pen3'B'def']rowse filenotes   'pen6'|'def||CR
  1013.     SAY pen6' |'def'   ['pen3'N'def']ew files list     'pen6'|'def||CR
  1014.     SAY pen6' |'def'   ['pen3'L'def']ist by Library    'pen6'|'def||CR
  1015.     SAY pen6' |'def'   ['pen3'F'def']ilelist archives  'pen6'|'def||CR
  1016.     SAY pen6' |'def'   ['pen3'S'def']earch files       'pen6'|'def||CR
  1017.     SAY pen6' |'def'   ['pen3'U'def']pload             'pen6'|'def||CR
  1018.     SAY pen6' |'def'   ['pen3'D'def']ownload           'pen6'|'def||CR
  1019.     SAY pen6' |'def'   ['pen3'T'def']ransfer protocol  'pen6'|'def||CR
  1020.     SAY pen6' |'def'   ['pen3'+'def'] Extra Devices    'pen6'|'def||CR
  1021. IF(level>sysoplevel) THEN DO
  1022.     SAY pen6' |'def'   ['pen3'K'def']ill a user        'pen6'|'def||CR
  1023.     SAY pen6' |'def'   ['pen3'%'def'] edit filenote    'pen6'|'def||CR
  1024.     SAY pen6' |'def'   ['pen3'('def'] file report      'pen6'|'def||CR
  1025.     SAY pen6' |'def'   ['pen3';'def'] change username  'pen6'|'def||CR;END
  1026. IF(level=99) THEN DO
  1027.     SAY pen6' |'def'   ['pen3'@'def'] dos shell        'pen6'|'def||CR;END
  1028.     SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
  1029.     SAY pen6' |'def'   ['pen3'.'def'] main menu        'pen6'|'def||CR
  1030.     SAY pen6' |________________________|'def||CR
  1031.   END
  1032. ELSE IF menu='MAIN' THEN
  1033.   DO
  1034.     SAY pen6'       _____________'def||CR
  1035.     SAY pen6'  ____/  'pen3'Main Menu'pen6'  \_____'def||CR
  1036.     SAY pen6' |                        |'def||CR
  1037.     SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
  1038.     SAY pen6' |'def'   ['pen3'I'def']nfomation         'pen6'|'def||CR
  1039.     SAY pen6' |'def'   ['pen3'J'def']ump to doorways   'pen6'|'def||CR
  1040.     SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
  1041.     SAY pen6' |'def'   ['pen3'W'def']ho is here list   'pen6'|'def||CR
  1042.     SAY pen6' |'def'   ['pen3'S'def']earch userlist    'pen6'|'def||CR
  1043.     SAY pen6' |'def'   ['pen3'O'def']ther users info   'pen6'|'def||CR
  1044.     SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
  1045.     SAY pen6' |'def'   ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
  1046.     SAY pen6' |'def'   ['pen3'#'def'] toggle colors    'pen6'|'def||CR
  1047.     SAY pen6' |'def'   ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
  1048.     SAY pen6' |'def'   ['pen3'&'def'] user profiles    'pen6'|'def||CR
  1049.     SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
  1050.     SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
  1051.     SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
  1052.     SAY pen6' |'def'   ['pen3'F'def']iles menu         'pen6'|'def||CR
  1053.     SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
  1054.     SAY pen6' |________________________|'def||CR
  1055.   END
  1056. ELSE IF menu='ALL' THEN
  1057.   DO
  1058.     SAY pen6'     __________________________________________________________'def||CR
  1059.     SAY pen6'  __/   'pen3'Main Menu            File Menu          Message Menu 'pen6'  \__'def||CR
  1060.     SAY pen6' |                                                                |'def||CR
  1061.     SAY pen6' |'def' ['pen3'H'def']elp               ['pen3'A'def']lphabetical list  ['pen3'P'def']ost messages      'pen6'|'def||CR
  1062.     SAY pen6' |'def' ['pen3'I'def']nformation        ['pen3'B'def']rowse filenotes   ['pen3'R'def']ead messages      'pen6'|'def||CR
  1063.     SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics   ['pen3'L'def']ist by Library    ['pen3'E'def']mail (private)    'pen6'|'def||CR
  1064.     SAY pen6' |'def' ['pen3'Y'def']our user data     ['pen3'N'def']ew files          ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
  1065.     SAY pen6' |'def' ['pen3'O'def']ther users info   ['pen3'F'def']ilelist archiver  ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
  1066.     SAY pen6' |'def' ['pen3'J'def']ump to doorways   ['pen3'+'def'] Extra Devices    ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
  1067.     SAY pen6' |'def' ['pen3'S'def']earch menu        ['pen3'D'def']ownload           ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
  1068.     SAY pen6' |'def' ['pen3'&'def'] user profiles    ['pen3'U'def']pload             ['pen3'#'def'] toggle colors    'pen6'|'def||CR
  1069.     SAY pen6' |'def' ['pen3'V'def']iew user log      ['pen3'T'def']ransfer protocol  ['pen3','def'] hourly stats     'pen6'|'def||CR
  1070.     SAY pen6' |'def' ['pen3'G'def']oodbye (logoff)   ['pen3'QUICK'def'] options      ['pen3'FL'def'] Friends List    'pen6'|'def||CR
  1071. IF(level>sysoplevel) THEN DO
  1072.     SAY pen6' |'def' ['pen3'K'def']ill a user        ['pen3'%'def'] edit filenote    ['pen3'='def'] level report     'pen6'|'def||CR
  1073.     SAY pen6' |'def' ['pen3'^'def'] view BBS logs    ['pen3'('def'] file report      ['pen3';'def'] change username  'pen6'|'def||CR;END
  1074. IF(level=99) THEN
  1075.     SAY pen6' |'def' ['pen3'~'def'] online editor    ['pen3'@'def'] dos shell        ['pen3')'def'] email report     'pen6'|'def||CR
  1076.     SAY pen6' |________________________________________________________________|'def||CR
  1077.   END
  1078. QUEUE CR  /* clears any un-CRed input in the queue */
  1079. RETURN
  1080.  
  1081.  
  1082. help:
  1083. ARG helppath .
  1084. SAY CR
  1085. SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'CR
  1086. IF helppath='MAIN' THEN
  1087.   SAY 'Commands available from the' pen3||menu||def 'menu:'CR
  1088. frontend=bbspath'BBS_HELP/'helppath
  1089. backend='.USER'
  1090. IF level=0 THEN backend='.NEW'
  1091. ELSE IF level=99 THEN backend='.SUPER'
  1092. ELSE IF level>sysoplevel THEN backend='.SYSOP'
  1093. CALL showtext(frontend||backend)
  1094. RETURN
  1095.  
  1096.  
  1097. waiting:
  1098. CALL checktime()
  1099. IF waitchar='Q' THEN
  1100.   DO
  1101.     waitchar=''
  1102.     RETURN
  1103.   END
  1104. waitchar=''
  1105. IF nonstop=1 THEN RETURN
  1106. OPTIONS PROMPT pen3'                          RETURN=Continue 'def
  1107. PULL waitchar
  1108. CALL cleanline(1)
  1109. CALL checkdcd()
  1110. RETURN
  1111.  
  1112.  
  1113. waiting2:
  1114. CALL checktime()
  1115. IF nonstop=1 THEN RETURN 0
  1116. waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
  1117. IF waitchar='N' THEN
  1118.   DO
  1119.     nonstop=1
  1120.     SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
  1121.     SAY CR
  1122.     CALL DELAY(100)
  1123.     waitchar=''
  1124.   END
  1125. CALL cleanline(1)
  1126. CALL checkdcd()
  1127. IF waitchar='Q' THEN RETURN 1
  1128. RETURN 0
  1129.  
  1130.  
  1131. busywait:
  1132. ARG bii bi bt 
  1133. IF bii>4 & bi//(10*bii)=0 THEN CALL checkdcd()
  1134. IF bbsprefs.21=0 THEN RETURN
  1135. IF bi<1 THEN
  1136.   DO
  1137.     CALL WRITECH(STDOUT,'080808'x)
  1138.     IF ni<1 & i=999999 & wi=999999 THEN SAY CR
  1139.     RETURN
  1140.   END
  1141. IF bi=1 THEN CALL WRITECH(STDOUT,'   ')
  1142. IF bi//(bii%2)~=0 THEN RETURN
  1143. b=bi//bii
  1144. IF b=0 | b=bii%2 THEN
  1145.   DO
  1146.     tp=RIGHT((bi*100)%bt,2)'%'
  1147.     CALL WRITECH(STDOUT,'080808'x||tp)
  1148.   END
  1149. RETURN
  1150.  
  1151.  
  1152. cleanline:
  1153. ARG lflag .
  1154. IF nonstop=0 & clr~='' THEN
  1155.   DO
  1156.     Send clr
  1157.     RETURN
  1158.   END
  1159. IF colorflag~=1 & lflag=1 THEN RETURN
  1160. cline=lineup||LEFT(' ',78)
  1161. IF lflag=1 THEN cline=cline||lineup
  1162. SAY cline||CR
  1163. RETURN
  1164.  
  1165.  
  1166. getinput:
  1167. PARSE ARG upflag' 'oneflag' 'pline
  1168. CALL checkdcd()
  1169. OPTIONS PROMPT pline
  1170. PARSE PULL inarg
  1171. inarg=STRIP(inarg)
  1172. IF upflag THEN inarg=UPPER(inarg)
  1173. IF oneflag THEN inarg=LEFT(inarg,1)
  1174. inarg=cleanstring(0':'inarg)
  1175. RETURN inarg
  1176.  
  1177.  
  1178. docity:
  1179. PARSE ARG citi
  1180. citi=TRANSLATE(citi,'          ','+-.,*/()<>')
  1181. DO i=WORDS(citi) TO 1 BY -1
  1182.   IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  1183.   IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
  1184. END
  1185. citi=SPACE(citi,1)
  1186. RETURN STRIP(citi)
  1187.  
  1188.  
  1189. postuser:
  1190. IF bbsprefs.12~=1 THEN RETURN
  1191. ARG upflag .
  1192. IF upflag=6 THEN ptext='Logoff:' DATE() TIME('C')'  'name city
  1193. ELSE IF upflag=7 THEN ptext=name'  is a NEW USER!'
  1194. ELSE ptext='LogOn:' logontime'  'name city'  Last On:' DATE(,lastondate,'I')
  1195. ptext=CENTER(ptext,74)'\'
  1196. age='?'
  1197. IF UPPER(WORD(data.12,3))='BIRTHDAY:' THEN
  1198.   DO
  1199.     IF DATATYPE(WORD(data.12,4),'W') THEN
  1200.       DO
  1201.         age=LEFT(DATE('S'),4)-LEFT(WORD(data.12,4),4)
  1202.         IF SUBSTR(DATE('S'),5,2)<SUBSTR(WORD(data.12,4),5,2) THEN age=age-1
  1203.       END
  1204.   END
  1205. IF age='?' & WORD(data.12,4)~='' THEN age=WORD(data.12,4)
  1206. ptext=ptext||CENTER('Baud:' bps'   Age:' age'   Usage:' data.19,74)'\'
  1207. ptext2=''
  1208. ptext1=data.1'   '
  1209. IF DATATYPE(WORD(data.12,1),'W') THEN
  1210.   ptext2=ptext2'   First On:' DATE(,WORD(data.12,1),'S')
  1211. n=74-LENGTH(ptext1)-LENGTH(ptext2)
  1212. ptext2=ptext1||STRIP(LEFT(data.9,n))||ptext2
  1213. ptext=ptext||CENTER(ptext2,74)'\'
  1214. ulb=WORD(data.14,3)
  1215. IF ~DATATYPE(ulb,'W') | ulb=0 THEN ulb=1
  1216. dlb=WORD(data.15,3)
  1217. IF ~DATATYPE(dlb,'W') THEN dlb=0
  1218. dlup=TRUNC(dlb/ulb+.005,2)
  1219. line3='Level: 'level'   dl/ul:' dlup
  1220. IF upflag=0 THEN ptext=ptext||CENTER(line3,74)
  1221. IF upflag=1 THEN ptext=ptext||CENTER(line3'   Cmd:' opt arg,74)
  1222. IF upflag=2 THEN ptext=ptext||CENTER(line3'   MSG:' msg.msgdir,74)
  1223. IF upflag=3 THEN ptext=ptext||CENTER(line3'   Email',74)
  1224. IF upflag=4 THEN ptext=ptext||CENTER(line3'   ul:' arg 'in' plaindir,74)
  1225. IF upflag=5 THEN ptext=ptext||CENTER(line3'   dl:' arg 'in' plaindir,74)
  1226. IF upflag=6 THEN ptext=ptext||CENTER(line3'   Elapsed:'elapsed' ',74)
  1227. IF GETCLIP('BBS_fkeyhelp')=1 THEN CALL PostMsg(3,11,ptext)
  1228. ELSE CALL PostMsg(lpost,rpost,ptext)
  1229. ptext2=''
  1230. IF EXISTS(bbspath'Email/'sysop'/NEW_FILES') THEN ptext2='NEW_FILES !'
  1231. IF EXISTS(bbspath'Lists/CBV_USERS') THEN ptext2=ptext2 'CBV_USERS !'
  1232. IF EXISTS(bbspath'Lists/NEW_USERS') THEN ptext2=ptext2 'NEW_USERS !'
  1233. IF chatrequest=1 THEN ptext2=ptext2 'CHAT REQUEST !'
  1234. ptext2=STRIP(ptext2)
  1235. IF ptext2='' THEN CALL PostMsg(,,'\\\\ ')
  1236. ELSE CALL PostMsg(,,'\\\\ 'CENTER('!' ptext2,74))
  1237. RETURN
  1238.  
  1239.  
  1240. whodat:
  1241. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  1242. RETURN
  1243.  
  1244.  
  1245. showtime:
  1246. mins=TIME('E')%60
  1247. secs=TRUNC(TIME('E')//60)+1
  1248. IF secs>59 THEN secs=59
  1249. IF secs<10 THEN secs='0'secs
  1250. line=' Time:  Used' mins':'secs
  1251. mins=(maxtime-TIME('E'))%60
  1252. secs=TRUNC((maxtime-TIME('E'))//60)
  1253. IF secs<10 THEN secs='0'secs
  1254. line=line'   Remaining' mins':'secs
  1255. SAY line||CR
  1256.  
  1257. checktime:
  1258. IF TIME('E')>maxtime THEN
  1259.   DO
  1260.     SAY 'Sorry,' name 'your time has expired.'CR
  1261.     CALL send2log('*** Time Expired ***')
  1262.     SIGNAL LOGOUT2
  1263.   END
  1264. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  1265. CALL whodat()
  1266. CALL checkdcd()
  1267. RETURN
  1268.  
  1269.  
  1270. setdir:
  1271. PARSE ARG tempdir
  1272. CALL PRAGMA('D',STRIP(tempdir))
  1273. directory=PRAGMA('D')
  1274. Data directory
  1275. slash=LASTPOS('/',directory)
  1276. IF slash=0 THEN slash=LASTPOS(':',directory)
  1277. plaindir=directory
  1278. IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
  1279. RETURN
  1280.  
  1281.  
  1282. config:
  1283. arg='s:CONFIG.BBS'
  1284. IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
  1285. IF readlines(arg 1) THEN
  1286.   DO
  1287.     SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
  1288.     SIGNAL DONE2
  1289.   END
  1290. compos=POS('/*',lynes.1)
  1291. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  1292. bbsname=STRIP(lynes.1)
  1293. sysop=WORD(lynes.2,1)
  1294. compos=POS('/*',lynes.3)
  1295. IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
  1296. exclusion=STRIP(lynes.3)
  1297. bbsdevice=WORD(lynes.4,1)
  1298. sysoplevel=WORD(lynes.5,1)
  1299. bbspath=WORD(lynes.6,1)
  1300. IF ~EXISTS(bbspath) THEN
  1301.   DO
  1302.     SAY bbspath 'does not exist!'CR
  1303.     SIGNAL DONE2
  1304.   END
  1305. testchar=RIGHT(bbspath,1)
  1306. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  1307. CALL SETCLIP('BBS_path',bbspath)
  1308. msgpath=WORD(lynes.7,1)
  1309. IF ~EXISTS(msgpath) THEN
  1310.   DO
  1311.     SAY msgpath 'does not exist!'CR
  1312.     SIGNAL DONE2
  1313.   END
  1314. testchar=RIGHT(msgpath,1)
  1315. IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
  1316. CALL SETCLIP('BBS_msgpath',msgpath)
  1317. msgpath=msgpath'MSG'
  1318. libpath=WORD(lynes.8,1)
  1319. IF ~EXISTS(libpath) THEN
  1320.   DO
  1321.     SAY libpath 'does not exist!'CR
  1322.     SIGNAL DONE2
  1323.   END
  1324. testchar=RIGHT(libpath,1)
  1325. IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
  1326. CALL SETCLIP('BBS_libpath',libpath)
  1327. extdevs=''
  1328. DO i=1 TO WORDS(lynes.10)
  1329.   test=WORD(lynes.10,i)
  1330.   IF POS(':',test)=0 THEN ITERATE i
  1331.   IF LEFT(test,2)='/*' THEN LEAVE i
  1332.   extdevs=STRIP(extdevs test)
  1333. END
  1334. SYSTEM_MSG_LIMIT=WORD(lynes.11,1)
  1335. SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
  1336. maxidle=WORD(lynes.13,1)
  1337. maxtime=WORD(lynes.14,1)
  1338. maxbps=WORD(lynes.15,1)
  1339. IF ~DATATYPE(maxbps,'W') THEN maxbps=2400
  1340. CALL SETCLIP('BBS_baud',maxbps)
  1341. DO i=16 TO 40
  1342.   j=i-15
  1343.   bbsprefs.j=STRIP(WORD(lynes.i,1))
  1344. END
  1345. spellpath=WORD(lynes.9,1)
  1346. IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  1347.   DO
  1348.     SAY spellpath 'does not exist!'CR
  1349.     bbsprefs.5=0
  1350.   END
  1351. IF bbsprefs.10 THEN scratch=bbspath'Scratch'
  1352. ELSE scratch='RAM:Scratch'
  1353. CALL MAKEDIR(scratch)
  1354. IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3
  1355. extension=WORD(lynes.32,1)
  1356. arccom=lynes.33
  1357. compos=POS('/*',lynes.33)
  1358. IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
  1359. arccom=STRIP(lynes.33)
  1360. IF LEFT(extension,1)~='.' THEN
  1361.   DO
  1362.     extension='.lzh'
  1363.     arccom='lharc -m m'
  1364.   END
  1365. lpost=WORD(lynes.34,1)
  1366. IF ~DATATYPE(lpost,'W') THEN lpost=3
  1367. rpost=WORD(lynes.35,1)
  1368. IF ~DATATYPE(rpost,'W') THEN rpost=14
  1369. compos=POS('/*',lynes.42)
  1370. IF compos>0 THEN lynes.42=LEFT(lynes.42,compos-1)
  1371. bbsprefs.27=STRIP(lynes.42)
  1372. RETURN
  1373.  
  1374.  
  1375. readlogs:
  1376. IF arg='' THEN
  1377.   arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ')
  1378. IF arg='' THEN arg=DATE('S')
  1379. arg=bbspath'Logs/log.'arg
  1380. CALL readlines(arg 1)
  1381. CALL seelines(0)
  1382. nonstop=0
  1383. CALL waiting()
  1384. RETURN
  1385.  
  1386.  
  1387. loadcourtesy:
  1388. IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN
  1389.   DO
  1390.     IF readopen(bbspath'Lists/Courtesy') THEN
  1391.       DO
  1392.         SAY 'Checking Courtesy List...'CR
  1393.         DO i=1
  1394.           line=READLN(f)
  1395.           IF EOF(f) THEN BREAK
  1396.           line=cleanstring(1':'line)
  1397.           courtesy=courtesy line
  1398.         END
  1399.         CALL CLOSE(f)
  1400.         MSG ''
  1401.         MSG pen3'Courtesy List:'def
  1402.         MSG courtesy
  1403.       END
  1404.   END
  1405. RETURN
  1406.  
  1407.  
  1408. fileheader:
  1409. SAY 'Filename          Bytes File# Library         KeyWords'CR
  1410. SAY pen3||LEFT('=',77,'=')||def||CR
  1411. RETURN
  1412.  
  1413.  
  1414. showalpha:
  1415. IF DATATYPE(arg,'W') THEN
  1416.   DO
  1417.     dirnum=arg
  1418.     arg=''
  1419.     IF chdir2()>0 THEN RETURN
  1420.     test='Y'
  1421.   END
  1422. ELSE
  1423.   DO
  1424.     test=getinput(1 1 'Show one library only? (Ny) > ')
  1425.     IF test='Y' THEN
  1426.       DO
  1427.         IF chdir()>0 THEN RETURN
  1428.       END
  1429.   END
  1430.  
  1431. showalpha2:
  1432. IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
  1433. ELSE filecount=files.0
  1434. SAY '  'filecount 'files.'CR
  1435. CALL fileheader()
  1436. count=0
  1437. DO wi=1 TO alpha.0
  1438.   CALL busywait(60 wi alpha.0)
  1439.   IF test='Y' THEN
  1440.     DO
  1441.       IF count>=filecount THEN LEAVE wi
  1442.       IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.wi,5),12)) THEN
  1443.         ITERATE wi
  1444.     END
  1445.   jj=WORD(alpha.wi,4)
  1446.   IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN
  1447.     ITERATE wi
  1448.   CALL busywait(4 0)
  1449.   SAY alpha.wi||CR
  1450.   count=count+1
  1451.   IF (count+2)//linesperpage=0 THEN
  1452.     IF waiting2() THEN
  1453.       DO
  1454.         CALL busywait(4 1)
  1455.         LEAVE wi
  1456.       END
  1457.   CALL busywait(4 1)
  1458. END
  1459. CALL busywait(4 0)
  1460. nonstop=0
  1461. IF waitchar~='Q' THEN CALL waiting()
  1462. RETURN
  1463.  
  1464.  
  1465. profiles:
  1466. prodir=bbspath'Profiles'
  1467. CALL MAKEDIR(prodir)
  1468. pros=SHOWDIR(prodir)
  1469. protxt=bbspath'BBS_TEXT/PROFILES'
  1470. IF EXISTS(protxt) THEN CALL showtext(protxt)
  1471. DO lupe=1
  1472.   SAY CR
  1473.   SAY '       1. Edit 'name'''s user Profile'CR
  1474.   SAY '       2. View a User Profile'CR
  1475.   SAY '       3. Search User Profiles'CR
  1476.   SAY '       4. Browse User Profiles'CR
  1477.   SAY CR
  1478.   temp=getinput(1 1 'Enter Selection Number > ')
  1479.   IF temp=1 THEN
  1480.     DO
  1481.       lynes.=''
  1482.       IF EXISTS(prodir'/'name) THEN
  1483.         DO
  1484.           IF readlines(prodir'/'name 1)~=0 THEN ITERATE lupe
  1485.           CALL DELETE(prodir'/'name)
  1486.         END
  1487.       ELSE lynes.0=3
  1488.       lynes.1=name
  1489.       lynes.2='Profile Last Updated:' DATE('W') DATE() TIME('C')
  1490.       lynes.3=LEFT('=',74,'=')
  1491.       IF savelines(prodir'/'name)~=0 THEN
  1492.         DO
  1493.           line='Profile for' name 'failed to save!'
  1494.           SAY line||CR
  1495.           CALL send2log(line)
  1496.           ITERATE lupe
  1497.         END
  1498.       edtype=''
  1499.       CALL bbsEd(4 prodir'/'name)
  1500.       IF readlines(prodir'/'name 1)~=0 THEN CALL DELETE(prodir'/'name)
  1501.       IF lynes.0<4 THEN CALL DELETE(prodir'/'name)
  1502.       pros=SHOWDIR(prodir)
  1503.     END
  1504.   ELSE IF temp=2 THEN
  1505.     DO pf=1
  1506.       totpros=WORDS(pros)
  1507.       DO pfl=1 TO totpros BY 3
  1508.         pfl2=pfl+1
  1509.         pfl3=pfl+2
  1510.         pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(pros,pfl),21)
  1511.         IF pfl2<=totpros THEN
  1512.           pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(pros,pfl2),21)
  1513.         IF pfl3<=totpros THEN
  1514.           pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(pros,pfl3),21)
  1515.         SAY pfline||CR
  1516.         IF nonstop~=1 & ((pfl3%3)//linesperpage)=0 THEN
  1517.           IF waiting(2) THEN LEAVE pfl
  1518.       END
  1519.       emnum=getinput(1 0 pen3'Select User Profile Number > 'def)
  1520.       IF DATATYPE(emnum,'W') & emnum>0 & emnum<=totpros THEN
  1521.         DO
  1522.           tmp=WORD(pros,emnum)
  1523.           IF level>sysoplevel THEN
  1524.             DO
  1525.               CALL bbsEd(1 prodir'/'tmp)
  1526.               IF readlines(prodir'/'tmp 1)~=0 THEN CALL DELETE(prodir'/'tmp)
  1527.               IF lynes.0<4 THEN CALL DELETE(prodir'/'tmp)
  1528.               pros=SHOWDIR(prodir)
  1529.             END
  1530.           ELSE CALL showtext(prodir'/'tmp)
  1531.         END
  1532.       ELSE LEAVE pf
  1533.     END
  1534.   ELSE IF temp=3 | temp=4 THEN
  1535.     DO
  1536.       searcharg=''
  1537.       nonstop=0
  1538.       IF temp=3 THEN
  1539.         DO
  1540.           searcharg=STRIP(getinput(0 0 'Enter Search Phrase > '))
  1541.           IF searcharg='' THEN ITERATE lupe
  1542.         END
  1543.       DO ui=1 TO WORDS(pros)
  1544.         pro=prodir'/'WORD(pros,ui)
  1545.         IF temp=3 THEN
  1546.           IF textsearch(pro searcharg)=0 THEN ITERATE ui
  1547.         SAY CR
  1548.         CALL readlines(pro 1)
  1549.         IF nonstop=1 THEN rnonstop=1
  1550.         ELSE rnonstop=0
  1551.         CALL seelines(2)
  1552.         IF rnonstop THEN nonstop=1
  1553.         ELSE IF waiting2()=1 THEN LEAVE ui
  1554.         SAY CR
  1555.         SAY CR
  1556.       END
  1557.     END
  1558.   ELSE IF temp='' | LEFT(temp,1)='Q' THEN LEAVE lupe
  1559. END
  1560. DROP pros
  1561. RETURN
  1562.  
  1563.  
  1564. otheruser:
  1565. line=''
  1566. IF level>sysoplevel THEN line='['pen3'R'def']eport or'
  1567. line=line '['pen3'D'def']etails or simple ['pen3'N'def']amelist?'
  1568. IF level>sysoplevel THEN line=line '(Dnr) > '
  1569. ELSE line=line '(Dn) > '
  1570. temp=getinput(1 1 line)
  1571. IF temp='N' THEN
  1572.   DO
  1573.     CALL showuserlist()
  1574.     RETURN
  1575.   END
  1576. ELSE IF level>sysoplevel & temp='R' THEN
  1577.   DO
  1578.     SAY CR
  1579.     line=''
  1580.     IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN
  1581.       DO
  1582.         CALL cleanline(0)
  1583.         SAY 'INACTIVE_USERS report will be in your email.'CR
  1584.         line='USERS '
  1585.       END
  1586.     IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN
  1587.       DO
  1588.         CALL cleanline(0)
  1589.         line=line'FILES'
  1590.         line=STRIP(line getinput(1 0 'Report only files larger than (0) bytes > '))
  1591.         SAY 'FILELISTS_REPORT will be in your email.'CR
  1592.       END
  1593.     SAY CR
  1594.     ADDRESS AREXX bbsREPORT.rexx name line 
  1595.     RETURN
  1596.   END
  1597. SAY CR
  1598. SAY 'To allow (or not) other users to see your street address and/or phone number,'CR
  1599. SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'CR
  1600. SAY CR
  1601. SAY 'User specification may include ? wildcard for single characters.'CR
  1602. SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'CR
  1603. IF arg='' THEN arg=getinput(1 0 pen3'User specification: 'def)
  1604. IF arg='' THEN RETURN
  1605. arg=TRANSLATE(STRIP(arg),'_',' ')
  1606. CALL FileList(bbspath'Users/*'arg'*',wildlist)
  1607. line='Found' wildlist.0 'match'
  1608. IF wildlist.0~=1 THEN line=line'es'
  1609. SAY line'.'CR
  1610. IF wildlist.0<1 THEN RETURN
  1611. totlines=0
  1612. nextpagebreak=linesperpage-3
  1613. extrainfo=0
  1614. IF level>sysoplevel THEN
  1615.   DO
  1616.     IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
  1617.       extrainfo=1
  1618.   END
  1619. DO i=1 TO wildlist.0
  1620.   CALL readlines(wildlist.i 1)
  1621.   SAY CR
  1622.   totlines=totlines+6
  1623.   SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def||CR
  1624.   SAY lynes.1||CR
  1625.   IF FIND(UPPER(lynes.8),'STREET')>0 THEN
  1626.     DO
  1627.       totlines=totlines+1
  1628.       SAY lynes.2||CR
  1629.     END
  1630.   SAY lynes.3||CR
  1631.   IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
  1632.     DO
  1633.       totlines=totlines+1
  1634.       SAY lynes.4||CR
  1635.     END
  1636.   SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)||CR
  1637.   SAY pen3'Interests:'def lynes.10||CR
  1638.   IF extrainfo THEN
  1639.     DO
  1640.       SAY pen3'   up:'def lynes.14||CR
  1641.       SAY pen3' down:'def lynes.15||CR
  1642.       temptot=0
  1643.       DO j=1 TO WORDS(lynes.23)
  1644.         IF DATATYPE(WORD(lynes.23,j),'W') THEN temptot=temptot+WORD(lynes.23,j)
  1645.       END
  1646.       SAY pen3' writ:'def temptot 'public messages.'CR
  1647.       SAY pen3'level:'def lynes.20||CR
  1648.       totlines=totlines+4
  1649.       IF lynes.21~='' THEN
  1650.         DO
  1651.           totlines=totlines+1
  1652.           SAY pen3'excluded dirs:'def lynes.21||CR
  1653.         END
  1654.     END
  1655.   IF nonstop~=1 & totlines>=nextpagebreak THEN
  1656.     DO
  1657.       IF waiting2() THEN LEAVE i
  1658.       nextpagebreak=totlines+linesperpage-5
  1659.     END
  1660. END
  1661. nonstop=0
  1662. DROP wildlist.
  1663. IF waitchar~='Q' THEN CALL waiting()
  1664. RETURN
  1665.  
  1666.  
  1667. changename:
  1668. ARG cname
  1669. IF level<=sysoplevel THEN RETURN
  1670. IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ')
  1671. IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN
  1672. IF WORD(lynes,20)>=level THEN RETURN
  1673. CALL SETCLIP('BBS_oldname',cname)
  1674. CALL ChangeUserName.rexx()
  1675. ncname=GETCLIP('BBS_newname')
  1676. IF GETCLIP('BBS_oldname')='' THEN
  1677.   CALL send2log('Name change from' cname 'to' ncname)
  1678. CALL DELETE(bbspath'Lists/USERS')
  1679. sortuserflag=1
  1680. CALL SETCLIP('BBS_oldname')
  1681. CALL SETCLIP('BBS_newname')
  1682. RETURN ncname
  1683.  
  1684.  
  1685. levelreport:
  1686. minlev=0
  1687. maxlev=99
  1688. templist=''
  1689. uname=''
  1690. newufile=bbspath'Lists/NEW_USERS'
  1691. IF EXISTS(newufile) THEN
  1692.   DO
  1693.     IF getinput(1 1 'Latest New Users Only? (nY) > ')~='N' THEN
  1694.       DO
  1695.         IF readlines(newufile 1)=0 THEN
  1696.           DO i=2 TO lynes.0
  1697.             templist=STRIP(templist WORD(lynes.i,3))
  1698.           END
  1699.       END
  1700.     ELSE newufile=''
  1701.   END
  1702. ELSE newufile=''
  1703. IF newufile='' THEN
  1704.   DO
  1705.     minlev=getinput(1 0 'Minimum level? (0) > ')
  1706.     maxlev=getinput(1 0 'Maximum level? (99) > ')
  1707.     IF ~DATATYPE(minlev,'W') THEN minlev=0
  1708.     IF ~DATATYPE(maxlev,'W') THEN maxlev=99
  1709.     IF minlev<0 | minlev>99 THEN minlev=0
  1710.     IF maxlev<0 | maxlev>99 THEN maxlev=99
  1711.     templist=userlist
  1712.   END
  1713. DO levi=1 TO WORDS(templist)
  1714.   arg=bbspath'Users/'WORD(templist,levi)
  1715.   CALL readlines(arg 1)
  1716.   lt=WORD(lynes.20,1)
  1717.   IF ~DATATYPE(lt,'W') THEN lt=0
  1718.   IF lt<minlev | lt>maxlev THEN ITERATE levi
  1719.   line=lt WORD(templist,levi)
  1720.   SAY line||CR
  1721.   IF newufile~='' | lt<10 THEN
  1722.     DO
  1723.       SAY CR||LF||line||CR
  1724.       DO levj=1 TO 12
  1725.         SAY pen3'  'lynes.levj||def||CR
  1726.       END
  1727.       SAY pen3'  'lynes.19||def||CR
  1728.     END
  1729.   ELSE ITERATE levi
  1730.   lcom=''
  1731.   IF lt<10 THEN lcom='['pen3'A'def']dd  '
  1732.   lcom=lcom'['pen3'K'def']ill  ['pen3'R'def']ename  ['pen3'S'def']kip this user?'
  1733.   IF lt<10 THEN lcom=lcom' (Akrs) > '
  1734.   ELSE lcom=lcom '(krS) > '
  1735.   lcom=getinput(1 1 lcom)
  1736.   CALL cleanline(0)
  1737.   IF lcom='K' THEN
  1738.     DO
  1739.       arg=WORD(templist,levi)
  1740.       CALL killuser()
  1741.     END
  1742.   ELSE IF lcom='R' THEN
  1743.     DO
  1744.       newname=changename(WORD(templist,levi))
  1745.       IF newname~='' & newname~=WORD(templist,levi) THEN
  1746.         DO
  1747.           temp=WORDINDEX(templist,levi+1)
  1748.           rtemp=''
  1749.           IF temp>0 THEN rtemp=SUBSTR(templist,temp)
  1750.           temp=WORDINDEX(templist,levi)
  1751.           templist=''
  1752.           IF temp>2 THEN templist=STRIP(LEFT(templist,temp-1))
  1753.           templist=STRIP(templist newname rtemp)
  1754.           userlist=userlist newname
  1755.         END
  1756.       levi=levi-1
  1757.       CALL SETCLIP('BBS_newname')
  1758.     END
  1759.   ELSE IF lcom~='S' & lt<10 THEN
  1760.     DO
  1761.       IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
  1762.         DO
  1763.           DO lvi=1 TO 22
  1764.             line=READLN(f)
  1765.             IF lvi=11 THEN lynes.11=line
  1766.             IF lvi=20 THEN lynes.20=line
  1767.             IF lvi=21 THEN lynes.21=line
  1768.           END
  1769.           lynes.22=line
  1770.           CALL CLOSE(f)
  1771.           edtype=''
  1772.           IF bbsprefs.25=1 THEN
  1773.             DO
  1774.               SAY CR
  1775.               lynes.22=''
  1776.               lynes.23=''
  1777.               IF DATATYPE(lynes.20,'W') THEN
  1778.                 DO
  1779.                   SAY 'Setting message counters to last 10 messages in each conference...'CR
  1780.                   DO i=1 TO lynes.20
  1781.                     num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
  1782.                     IF num<0 | msg.i.0<10 THEN num=0
  1783.                     lynes.22=lynes.22 num
  1784.                     lynes.23=lynes.23 0
  1785.                   END
  1786.                 END
  1787.               ELSE CALL send2log('Bad default level in BBS_TEXT/DEF.MEMBER file!')
  1788.               SAY 'Setting file counter to last file uploaded...'CR
  1789.               lynes.16=countcheck(bbspath'Numbers/LastFile' 0)
  1790.               lynes.16=lynes.16 '19900101 00:00:00'
  1791.             END
  1792.           lynes.0=27
  1793.           CALL savelines(arg)
  1794.           SAY lynes.20 WORD(templist,levi) 'has been made a member.'CR
  1795.         END
  1796.       ELSE SAY 'You need a default member file in BBS_TEXT!  ( BBS_TEXT/DEF.MEMBER )'CR
  1797.     END
  1798.   IF lcom~='K' & lcom~='R' & newufile~='' THEN
  1799.     DO
  1800.       nlt=getinput(1 0 lynes.20 'Enter new level or blank for no change. > ')
  1801.       IF DATATYPE(nlt,'W') THEN
  1802.         DO
  1803.           lynes.20=nlt
  1804.           edtype=''
  1805.           CALL savelines(arg)
  1806.         END
  1807.       CALL writenew()
  1808.     END
  1809. END
  1810. IF newufile~='' & EXISTS(newufile) THEN
  1811.   IF getinput(1 1 'Delete NEW_USERS file? (nY) > ')~='N' THEN CALL DELETE(newufile)
  1812. IF EXISTS(bbspath'Lists/CBV_USERS') THEN
  1813.   IF getinput(1 1 'Delete CBV_USERS file? (nY) > ')~='N' THEN
  1814.     CALL DELETE(bbspath'Lists/CBV_USERS')
  1815. DROP templist
  1816. RETURN
  1817.  
  1818.  
  1819. writenew:
  1820. arg=WORD(templist,levi)
  1821. IF getinput(1 1 'Write' arg 'an email message? (nY) > ')~='N' THEN
  1822.   DO
  1823.     IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
  1824.       IF getinput(1 1 'Use default welcome? (nY) > ')~='N' THEN replysubj='|@NEW@|'
  1825.     CALL editor('MAIL' arg)
  1826.   END
  1827. RETURN
  1828.  
  1829.  
  1830. filereport:
  1831. SAY 'Searching for mismatches between files and filenotes...'CR
  1832. DO i=1 TO sysoplevel+1
  1833.   IF dirs.i='' THEN ITERATE
  1834.   SAY dirs.i'                               'lineup||CR
  1835.   rfiles=SHOWDIR(libpath||dirs.i)
  1836.   rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
  1837.   IF WORDS(rfiles)~=WORDS(rnotes) THEN
  1838.     DO
  1839.       line='Compare files & filenotes in'pen3 dirs.i||def'. '
  1840.       DO j=1 TO WORDS(rfiles)
  1841.         IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
  1842.           line=line WORD(rfiles,j)
  1843.       END
  1844.       SAY line||CR
  1845.     END
  1846. END
  1847. Send '^G'
  1848. CALL waiting()
  1849. RETURN
  1850.  
  1851.  
  1852. mailreport:
  1853. SAY 'Checking ALL pending Email...'CR
  1854. SAY pen3' - Use CTRL-E to Exit -'def||CR
  1855. SAY CR
  1856. mailrep=SHOWDIR(bbspath'Email','D')
  1857. mailfil=SHOWDIR(bbspath'EmailFiles','D')
  1858. lastemail=WORD(data.17,3)
  1859. IF ~DATATYPE(lastemail,'W') THEN lastemail=0
  1860. IF lastemail=countcheck(bbspath'Numbers/LastMail' 0) THEN
  1861.   DO
  1862.     DROP mailrep. mailfil.
  1863.     RETURN
  1864.   END
  1865. mailynes.=''
  1866. mk=0
  1867. DO mi=1 TO WORDS(mailrep)
  1868.   muser=WORD(mailrep,mi)
  1869.   IF muser=sysop | muser=name THEN ITERATE mi
  1870.   mlist=SHOWDIR(bbspath'Email/'muser)
  1871.   IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)||CR
  1872.   DO mj=1 TO WORDS(mlist)
  1873.     fuser=WORD(mlist,mj)
  1874.     IF POS(sysop,fuser)>0 THEN ITERATE mj
  1875.     IF logonflag=0 THEN
  1876.       DO
  1877.         mk=mk+1
  1878.         mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
  1879.       END
  1880.     IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
  1881.       DO
  1882.         testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
  1883.         IF testnum>emailnum THEN emailnum=testnum
  1884.         IF testnum>lastemail THEN
  1885.           DO
  1886.             CALL showtext(bbspath'Email/'muser'/'fuser)
  1887.             SAY CR
  1888.             SAY CR
  1889.             IF waitchar='Q' THEN LEAVE mi
  1890.           END
  1891.       END
  1892.   END
  1893.   IF logonflag=0 & FIND(mailfil,muser)>0 THEN
  1894.     DO
  1895.       efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
  1896.       IF WORDS(efilelist)>0 THEN
  1897.         DO
  1898.           mk=mk+1
  1899.           mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
  1900.         END
  1901.     END
  1902. END
  1903. data.17=WORD(data.17,1) WORD(data.17,2) countcheck(bbspath'Numbers/LastMail' 0)
  1904. IF mk>0 THEN
  1905.   DO
  1906.     lynes.0=mk
  1907.     DO mi=1 TO mk
  1908.       lynes.mi=mailynes.mi
  1909.     END
  1910.     CALL seelines(1)
  1911.     nonstop=0
  1912.     CALL waiting()
  1913.   END
  1914. ELSE SAY 'No unseen Email pending.'CR
  1915. DROP mailrep. mailfil. mailynes. mlist
  1916. RETURN
  1917.  
  1918.  
  1919. sortdoors:
  1920. IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
  1921. IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  1922.   DO
  1923.     jdoors.=''
  1924.     doorlist=SHOWDIR(bbspath'rexxDoors','F')
  1925.     doors.=''
  1926.     doors.0=WORDS(doorlist)
  1927.     DO i=1 TO doors.0
  1928.       doors.i=WORD(doorlist,i)
  1929.     END
  1930.     SAY 'Sorting..'lineup||CR
  1931.     IF doors.0>0 THEN CALL QSORT(1,doors.0,doors)
  1932.     jdoors.0=doors.0%3
  1933.     IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
  1934.     DO i=1 TO jdoors.0
  1935.       DO j=0 TO 2
  1936.         k=i+j*jdoors.0
  1937.         IF k<=doors.0 THEN
  1938.           DO
  1939.             jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
  1940.             dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
  1941.             jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
  1942.           END
  1943.       END
  1944.     END
  1945.   END
  1946. RETURN 0
  1947.  
  1948.  
  1949. jump2rexx:
  1950. CALL sound('JUMP')
  1951. CALL sortdoors()
  1952. temp=1
  1953. readcount=-1
  1954. DO doorloop=1
  1955.   IF temp=0 THEN
  1956.     DO
  1957.       IF readcount~=-1 THEN
  1958.         DO
  1959.           doors.0=''
  1960.           CALL sortdoors()
  1961.         END
  1962.       SAY CENTER('- Number of accesses per file -',75)||CR
  1963.     END
  1964.   SAY pen3||LEFT('-',75,'-')||def||CR
  1965.   DO jd=1 TO jdoors.0
  1966.     IF temp=0 THEN SAY jdoors.jd.0||CR
  1967.     ELSE SAY jdoors.jd||CR
  1968.     IF jd//linesperpage=0 THEN CALL waiting()
  1969.     IF waitchar='Q' THEN LEAVE doorloop
  1970.   END
  1971.   IF temp=0 THEN
  1972.     DO
  1973.       CALL waiting()
  1974.       temp=1
  1975.       ITERATE doorloop
  1976.     END
  1977.   temp=getinput(1 0 pen3'Select Application Number. 0=Stats > 'def)
  1978.   IF temp=0 THEN ITERATE doorloop
  1979.   IF ~DATATYPE(temp,'W') | temp<1 | temp>doors.0 THEN LEAVE doorloop
  1980.   IF TIME('E')>(maxtime-120) THEN
  1981.     DO
  1982.       SAY CR
  1983.       SAY '*** Less than 2 minutes left! ***'CR
  1984.       SAY '***   rexxDoors are closed!   ***'CR
  1985.       SAY CR
  1986.       LEAVE doorloop
  1987.     END
  1988.   arg=doors.temp
  1989.   IF GETCLIP('BBS_localdoor')=arg THEN
  1990.     DO
  1991.       SAY 'That door is in use!  Try again in a few minutes...'CR
  1992.       ITERATE doorloop
  1993.     END
  1994.   CALL SETCLIP('BBS_door',arg)
  1995.   readcount=WORD(STATEF(bbspath'rexxDoors/'arg),8)
  1996.   IF ~DATATYPE(readcount,'W') THEN readcount=0
  1997.   ADDRESS COMMAND 'C:filenote' bbspath'rexxDoors/'arg readcount+1
  1998.   CALL postuser(1)
  1999.   curdir=PRAGMA('D')
  2000.   CALL setdir(bbspath'rexxDoors')
  2001.   CALL send2log('Door: 'doors.temp 'at' TIME('C'))
  2002.   CALL SETCLIP('BBS_winnings')
  2003.   savewinnings=0
  2004.   timeleft=TRUNC(maxtime-TIME('E'))
  2005.   IF UPPER(doors.temp)='ONE_ARMED_BANDIT.REXX' THEN
  2006.     IF getinput(1 1 'Play for this sessions time in seconds? (Ny) > ')='Y' THEN
  2007.       DO
  2008.         savewinnings=winnings
  2009.         IF savewinnings=0 THEN savewinnings=1
  2010.         winnings=timeleft
  2011.         SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR
  2012.       END
  2013.   comm='CALL' doors.temp'('name winnings savewinnings colorflag timeleft-42')'
  2014.   INTERPRET comm
  2015.   testwin=GETCLIP('BBS_winnings')
  2016.   IF DATATYPE(testwin,'N') THEN
  2017.     DO
  2018.       IF savewinnings>0 THEN
  2019.         DO
  2020.           IF testwin>7200 THEN
  2021.             DO
  2022.               SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR
  2023.               testwin=7200
  2024.             END
  2025.           maxtime=TRUNC(testwin+TIME('E'))
  2026.           winnings=savewinnings
  2027.         END
  2028.       ELSE winnings=testwin
  2029.     END
  2030.   CALL setdir(curdir)
  2031.   CALL SETCLIP('BBS_winnings')
  2032.   CALL SETCLIP('BBS_door')
  2033.   SAY CR
  2034.   CALL showtime()
  2035. END
  2036. CALL SETCLIP('BBS_winnings')
  2037. CALL SETCLIP('BBS_door')
  2038. RETURN
  2039.  
  2040.  
  2041. sortlibraries:
  2042. SAY 'Sorting Libraries...'CR
  2043. count=0
  2044. sdirs.=''
  2045. DO i=1 TO level
  2046.   IF dirs.i='' THEN ITERATE i
  2047.   count=count+1
  2048.   sdirs.count=dirs.i i
  2049. END
  2050. sdirs.0=count
  2051. IF count>0 THEN CALL QSort(1,count,sdirs)
  2052. count=0
  2053. libs.=''
  2054. DO i=1 TO sdirs.0
  2055.   tempnum=WORD(sdirs.i,2)
  2056.   tempdir=WORD(sdirs.i,1)
  2057.   IF FIND(data.21,UPPER(tempdir))=0 THEN
  2058.     DO
  2059.       string=' '
  2060.       IF tempnum<10 THEN string=string' '
  2061.       string=string || tempnum'. 'LEFT(tempdir,14)
  2062.       count=count+1
  2063.       libs.count=string
  2064.     END
  2065. END
  2066. libs.0=count%4
  2067. IF (count//4)>0 THEN libs.0=libs.0+1
  2068. DO i=1 TO libs.0
  2069.   DO j=1 TO 3
  2070.     k=i+j*libs.0
  2071.     IF k<=count THEN libs.i=libs.i||libs.k
  2072.   END
  2073. END
  2074. DROP sdirs.
  2075. CALL sortconferences()
  2076. RETURN
  2077.  
  2078.  
  2079. sortconferences:
  2080. SAY 'Sorting Conferences...'CR
  2081. count=0
  2082. smsg.=''
  2083. DO i=1 TO level
  2084.   IF msg.i='' THEN ITERATE i
  2085.   count=count+1
  2086.   smsg.count=msg.i i
  2087. END
  2088. smsg.0=count
  2089. IF count>0 THEN CALL QSort(1,count,smsg)
  2090. count=0
  2091. msgs.=''
  2092. DO i=1 TO smsg.0
  2093.   tempnum=WORD(smsg.i,2)
  2094.   tempdir=WORD(smsg.i,1)
  2095.   IF FIND(data.21,tempnum)=0 THEN
  2096.     DO
  2097.       string=' '
  2098.       IF tempnum<10 THEN string=string' '
  2099.       string=string || tempnum'.'
  2100.       IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
  2101.         string=string LEFT(tempdir,20)
  2102.       ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
  2103.       count=count+1
  2104.       msgs.count=string
  2105.     END
  2106. END
  2107. msgs.0=count%3
  2108. IF (count//3)>0 THEN msgs.0=msgs.0+1
  2109. DO i=1 TO msgs.0
  2110.   DO j=1 TO 2
  2111.     k=i+j*msgs.0
  2112.     IF k<=count THEN msgs.i=msgs.i msgs.k
  2113.   END
  2114. END
  2115. DROP smsg.
  2116. RETURN
  2117.  
  2118.  
  2119. readmessages:
  2120. searcharg=''
  2121. DO FOREVER
  2122.   SAY CR
  2123.   PARSE VAR arg temp' 'arg .
  2124.   IF DATATYPE(temp,'W') THEN msgdir=temp
  2125.   ELSE IF LEFT(UPPER(temp),1)='A' THEN
  2126.     DO
  2127.       CALL newmsgs()
  2128.       arg=''
  2129.       RETURN
  2130.     END
  2131.   ELSE IF LEFT(UPPER(temp),1)='M' THEN
  2132.     DO
  2133.       CALL readmarked()
  2134.       arg=''
  2135.       RETURN
  2136.     END
  2137.   ELSE
  2138.     DO
  2139.       SAY 'Select Message Conference By' pen3'Number'def', ['pen3'M'def']arked only or ['pen3'A'def']ll Active'CR
  2140.       IF areaselect() THEN
  2141.         DO
  2142.           IF LEFT(temp,1)='A' THEN CALL newmsgs()
  2143.           IF LEFT(temp,1)='M' THEN CALL readmarked()
  2144.           RETURN
  2145.         END
  2146.     END
  2147.   pline='['pen3'A'def']rchive ['pen3'S'def']earch ['pen3'T'def']oggle ON/OFF'
  2148.   pline=pline '['pen3'R'def']ead ['pen3'Q'def']uit (aqRst) > '
  2149.   IF arg~='' THEN junk=UPPER(LEFT(arg,1))
  2150.   ELSE junk=getinput(1 1 pline)
  2151.   IF junk='Q' THEN RETURN
  2152.   IF junk='A' THEN
  2153.     DO
  2154.       SAY CR
  2155.       CALL msgcount(msgdir)
  2156.       junk=getinput(1 0 pen3'RETURN'def' to archive new msgs, ['pen3'Q'def']uit, or enter starting message number > ')
  2157.       IF junk='Q' THEN RETURN
  2158.       IF DATATYPE(junk,'W') THEN
  2159.         DO
  2160.           IF junk>lastmess | junk<1 THEN junk=1
  2161.           lastread.msgdir=junk-1
  2162.           CALL savedata(1)
  2163.         END
  2164.       CALL SETCLIP('BBS_MSGS','ON')
  2165.       SAY 'Archiving messages in the'pen3 msg.msgdir def'Conference...'CR
  2166.       lastread.msgdir=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  2167.       CALL send2log('Arc: ArcMsgs.rexx' msg.msgdir)
  2168.       ADDRESS AREXX ArcMsgs.rexx name msgdir
  2169.       IF emailonline>=0 THEN emailonline=emailonline+1
  2170.       DO WHILE GETCLIP('BBS_MSGS')~=''
  2171.         CALL DELAY(14)
  2172.       END
  2173.       SAY 'When completed, the archive will be attached to email addressed to you.'CR
  2174.       CALL savedata(1)
  2175.       SAY CR
  2176.       RETURN
  2177.     END
  2178.   IF junk='S' THEN
  2179.     DO
  2180.       searcharg=''
  2181.       searcharg=getinput(0 0 pen3'Search Phrase: 'def)
  2182.       IF LENGTH(STRIP(searcharg))=0 THEN RETURN
  2183.       searcharg=COMPRESS(searcharg,'*')
  2184.       SAY CR
  2185.       CALL searchmsgdir()
  2186.       SAY CR
  2187.       SAY lineup'All messages in the'pen3 msg.msgdir def'Conference have been searched.'CR
  2188.       SAY CR
  2189.       CALL waiting()
  2190.       searcharg=''
  2191.       RETURN
  2192.     END
  2193.   IF junk='T' THEN
  2194.     DO
  2195.       line='Turning the' msg.msgdir 'conference'
  2196.       IF WORD(data.22,msgdir)<0 THEN
  2197.         DO
  2198.           line=line pen3'ON'def'.'
  2199.           newdata='0'
  2200.         END
  2201.       ELSE
  2202.         DO
  2203.           line=line pen3'OFF'def'.'
  2204.           newdata='-1'
  2205.         END
  2206.       SAY line||CR
  2207.       dataloc=WORDINDEX(data.22,msgdir)-1
  2208.       data.22=DELWORD(data.22,msgdir,1)
  2209.       IF dataloc>0 THEN data.22=INSERT(newdata' ',data.22,dataloc)
  2210.       CALL sortconferences()
  2211.     END
  2212.   CALL readmsg(0)
  2213.   CALL saveData(1)
  2214.   nonstop=0
  2215.   arg=''
  2216. END
  2217. RETURN
  2218.  
  2219.  
  2220. newmsgs:
  2221. test=UPPER(LEFT(arg,1))
  2222. IF test='' THEN
  2223.   test=getinput(1 1 '['pen3'R'def']ead new messages or ['pen3'A'def']rchive for later download. (aR) > ')
  2224. IF test='A' THEN
  2225.   DO
  2226.     CALL SETCLIP('BBS_MSGS','ON')
  2227.     SAY CR
  2228.     SAY 'Archiving new conference messages...'CR
  2229.     CALL send2log('Arc: ArcMsgs.rexx')
  2230.     ADDRESS AREXX ArcMsgs.rexx name
  2231.     IF emailonline>=0 THEN emailonline=emailonline+1
  2232.     clear_marked=1
  2233.     DO i=1 TO level
  2234.       IF WORD(data.22,i)~=-1 THEN
  2235.         lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
  2236.     END
  2237.     DO WHILE GETCLIP('BBS_MSGS')~=''
  2238.       CALL DELAY(14)
  2239.     END
  2240.     SAY 'When completed, the archive will be attached to email addressed to you.'CR
  2241.     CALL savedata(1)
  2242.     SAY CR
  2243.     RETURN
  2244.   END
  2245. curmsgdir=msgdir
  2246. SAY 'Scanning all Conferences for new messages..'CR
  2247. DO newi=1 TO level
  2248.   IF msg.newi='' THEN ITERATE newi
  2249.   msgdir=newi
  2250.   CALL readmsg(1)
  2251.   IF msgcom='Q' THEN LEAVE newi
  2252. END
  2253. CALL saveData(1)
  2254. msgdir=curmsgdir
  2255. nonstop=0
  2256. RETURN
  2257.  
  2258.  
  2259. readmsg:
  2260. ARG quietflag marknum .
  2261. msgcom=''
  2262. IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN; /* sysop excluded */
  2263. IF WORD(data.22,msgdir)=-1 THEN RETURN;                /*  user excluded */
  2264. entering='Entering'pen3 msg.msgdir def'Message Conference..'
  2265. IF quietflag=0 & marknum='' THEN SAY entering||CR
  2266. CALL postuser(2)
  2267. IF DATATYPE(WORD(data.22,msgdir),'W') THEN
  2268.   lastread.msgdir=WORD(data.22,msgdir)
  2269. ELSE lastread.msgdir=0
  2270. lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  2271. frstwrt=countcheck(bbspath'Numbers/FirstMessage'msgdir 0)
  2272. temp=''
  2273. IF marknum='' THEN
  2274.   DO
  2275.     IF lastread.msgdir>=lstwrt | lastread.msgdir<frstwrt THEN
  2276.       DO
  2277.         CALL msgcount(msgdir)
  2278.         IF quietflag=1 & lastread.msgdir=lstwrt THEN RETURN
  2279.         IF nonstop=1 THEN temp=lastread.msgdir
  2280.         ELSE temp=getinput(1 0 pen3'Enter starting message number > 'def)
  2281.         IF temp='' & lastread.msgdir<lstwrt THEN temp=lastread.msgdir
  2282.         IF ~DATATYPE(temp,'W') THEN RETURN
  2283.         IF temp<frstwrt THEN temp=frstwrt
  2284.         IF temp>lstwrt THEN temp=lstwrt
  2285.         IF temp<1 THEN temp=1
  2286.         lastread.msgdir=temp-1
  2287.       END
  2288.   END
  2289. ELSE lastread.msgdir=marknum-1
  2290. IF quietflag=1 THEN SAY entering||CR
  2291. dirname=msgpath||msgdir
  2292. msglist.=0 /* set read to 0, unread to 1, and reply >=2 */
  2293. firstmess=999999
  2294. testlist=SHOWDIR(dirname)
  2295. DO i=1 TO WORDS(testlist)
  2296.   test=WORD(testlist,i)
  2297.   IF test>lastread.msgdir THEN msglist.test=1
  2298.   IF test<firstmess THEN firstmess=test
  2299. END
  2300. IF firstmess=999999 THEN firstmess=0
  2301. CALL countcheck(bbspath'Numbers/FirstMessage'msgdir firstmess)
  2302. msgstatus=1
  2303. IF temp='' & marknum='' THEN CALL msgcount(msgdir)
  2304. late.=''
  2305. late.0=0
  2306. skipsubj.=''
  2307. skipsubj.0=0
  2308. DO msgloop=1
  2309.   lastreadnum=lastread.msgdir
  2310.   DO WHILE msglist.lastreadnum=0 & lastreadnum<lstwrt
  2311.     lastreadnum=lastreadnum+1
  2312.   END
  2313.   lastread.msgdir=lastreadnum
  2314.   IF lastreadnum=lstwrt & msglist.lstwrt=0 THEN LEAVE msgloop
  2315.   DO mess=lastread.msgdir TO lstwrt+1
  2316.     IF marknum~='' THEN
  2317.       DO
  2318.         IF mess>marknum THEN LEAVE msgloop
  2319.         mess=marknum
  2320.       END
  2321.     IF msglist.mess~=msgstatus THEN ITERATE mess
  2322.     IF msgstatus>1 THEN SAY 'Following the thread, level' msgstatus-1'.'CR
  2323.     msglist.mess=0
  2324.     arg=dirname'/'mess
  2325.     IF ~EXISTS(arg) THEN
  2326.       DO
  2327.         SAY 'Message number' mess 'is missing.'CR
  2328.         ITERATE mess
  2329.       END
  2330.     IF ~readopen(arg) THEN ITERATE mess
  2331.     firstline=READLN(f)
  2332.     secondline=READLN(f)
  2333.     thirdline=READLN(f)
  2334.     forthline=READLN(f)
  2335.     CALL CLOSE(f)
  2336.     CALL killmark(msgdir mess)
  2337.     DO skp=1 TO skipsubj.0
  2338.       IF forthline=skipsubj.skp THEN ITERATE mess
  2339.     END
  2340.     IF WORDS(firstline)>2 THEN /* if replies, change their num to >1 */
  2341.       DO
  2342.         thread=SUBSTR(firstline,WORDINDEX(firstline,4))
  2343.         DO tindx=1 TO WORDS(thread)
  2344.           test=WORD(thread,tindx)
  2345.           IF msglist.test~=0 THEN msglist.test=msgstatus+1
  2346.         END
  2347.       END
  2348.     ELSE thread=''
  2349.     savearg=arg
  2350.     msgcom='A'
  2351.     DO msgloop2=1 WHILE msgcom='A' | msgcom='O'
  2352.       CALL readlines(arg 1)
  2353.       IF nonstop=1 THEN rnonstop=1
  2354.       ELSE rnonstop=0
  2355.       CALL seelines(2)
  2356.       IF name=WORD(lynes.3,2) THEN
  2357.         DO
  2358.           IF WORDS(lynes.3)//2=0 THEN
  2359.             DO
  2360.               lynes.3=lynes.3'  (Rcvd)'
  2361.               edtype=''
  2362.               CALL savelines(arg)
  2363.             END
  2364.         END
  2365.       msgcom=''
  2366.       CALL checktime()
  2367.       IF rnonstop THEN
  2368.         DO
  2369.           SAY CR
  2370.           nonstop=1
  2371.           msgcom=''
  2372.         END
  2373.       ELSE
  2374.         DO
  2375.           pline=''
  2376.           IF level<=sysoplevel | WORDS(lynes.3)<4 THEN pline='['pen3'A'def']gain'
  2377.           IF level>sysoplevel | name=WORD(lynes.2,2) THEN
  2378.             pline=pline '['pen3'E'def']dit ['pen3'K'def']ill'
  2379.           IF level>sysoplevel THEN pline=pline '['pen3'M'def']ove'
  2380.           IF WORDS(lynes.3)>3 THEN pline=pline '['pen3'O'def']riginal'
  2381.           pline=pline '['pen3'N'def']onStop ['pen3'R'def']eply'
  2382.           IF level=99 THEN pline=pline '['pen3'!'def']'
  2383.           pline=pline '['pen3'S'def']kip ['pen3'Q'def']uit ['pen3'?'def']'
  2384.           msgcom=getinput(1 0 STRIP(pline)' > ')
  2385.           CALL cleanline(0)
  2386.         END
  2387.       IF DATATYPE(msgcom,'W') & EXISTS(dirname'/'msgcom) THEN
  2388.         DO
  2389.           arg=dirname'/'msgcom
  2390.           IF msgcom>lastread.msgdir THEN lastread.msgdir=msgcom
  2391.           msgcom='A'
  2392.           ITERATE msgloop2
  2393.         END
  2394.       ELSE msgcom=LEFT(msgcom,1)
  2395.       IF msgcom='Q' THEN LEAVE msgloop
  2396.       ELSE IF msgcom='!' & level>sysoplevel THEN
  2397.         DO
  2398.           CALL DELETE(arg)
  2399.           newchar=LEFT(lynes.1,1)
  2400.           IF newchar~='!' THEN newchar='!!'
  2401.           ELSE newchar='  '
  2402.           lynes.1=OVERLAY(newchar,lynes.1,1,2)
  2403.           CALL savelines(arg)
  2404.           ITERATE msgloop2
  2405.         END
  2406.       ELSE IF msgcom='A' THEN ITERATE msgloop2
  2407.       ELSE IF msgcom='M' & level>sysoplevel THEN
  2408.         DO
  2409.           prevmsgdir=msgdir
  2410.           If ~areaselect() THEN
  2411.             DO
  2412.               himsg=countcheck(bbspath'Numbers/LastMessage'msgdir 0)+1
  2413.               lynes.1='  Msg:' himsg
  2414.               lynes.3='   To:' WORD(lynes.3,2)
  2415.               lynes.5=STRIP(DELWORD(lynes.5,8,1)) msg.msgdir
  2416.               nlyn=lynes.0+1
  2417.               lynes.0=nlyn
  2418.               lynes.nlyn=' *** Moved from the' msg.prevmsgdir 'conference ***'
  2419.               CALL savelines(msgpath||msgdir'/'himsg)
  2420.               CALL countcheck(bbspath'Numbers/LastMessage'msgdir himsg)
  2421.               CALL msgmark(WORD(lynes.3,2) msgdir himsg)
  2422.               CALL readlines(arg 1)
  2423.               CALL DELETE(arg)
  2424.               CALL DELAY(28)
  2425.               lynes.0=7
  2426.               lynes.7='*** Moved to the' msg.msgdir 'conference, message #'himsg' ***'
  2427.               CALL savelines(arg)
  2428.             END
  2429.           msgdir=prevmsgdir
  2430.           msgcom='A'
  2431.         END
  2432.       ELSE IF msgcom='N' THEN
  2433.         DO
  2434.           nonstop=1
  2435.           msgcom=''
  2436.         END
  2437.       ELSE IF msgcom='H' | msgcom='?' THEN
  2438.         DO
  2439.           SAY pen3' - HELP with the Read Messages commands -'def||CR
  2440.           SAY ' RETURN reads the next message in line.'CR
  2441.           SAY ' 34 will read message number 34, if it exists in this conference.'CR
  2442.           SAY ' A  reads this message Again (in case it scrolled off screen).'CR
  2443.           IF level>sysoplevel | name=WORD(lynes.2,2) THEN
  2444.             DO
  2445.           SAY ' E  puts this message into the online Editor.'CR
  2446.           SAY ' K  deletes a message you wrote. you cannot Kill others!'CR
  2447.             END
  2448.           IF level>sysoplevel THEN
  2449.           SAY ' M  move this message to a new conference.'CR
  2450.           SAY ' N  displays all new messages without pausing. CTRL-E to Exit!'CR
  2451.           SAY ' O  if this message is a reply, will read the Original message.'CR
  2452.           SAY ' R  enters the message editor to Reply to this message.'CR
  2453.           SAY ' S  allows you to Skip threads or conferences.'CR
  2454.         IF level=99 THEN
  2455.           SAY ' !  toggles the do-not-purge! flag for this message.'CR
  2456.           SAY ' Q  returns to the message menu. (Quit)'CR
  2457.           SAY CR
  2458.           CALL waiting()
  2459.           msgcom='A'
  2460.           IF waitchar='Q' THEN LEAVE msgloop
  2461.         END
  2462.       ELSE IF msgcom='E' THEN
  2463.         DO
  2464.           IF level>sysoplevel | name=WORD(lynes.2,2) THEN
  2465.             DO
  2466.               sline=7
  2467.               IF level>sysoplevel THEN sline=1
  2468.               CALL bbsED(sline arg)
  2469.               msgcom='A'
  2470.             END
  2471.         END
  2472.       ELSE IF msgcom='S' & mess<lstwrt THEN
  2473.         DO
  2474.           stemp=''
  2475.           req='Skip'
  2476.           IF WORDS(lynes.1)>2 THEN req=req 'this ['pen3'T'def']hread or'
  2477.           ELSE SAY 'There are no replies to this message.'CR
  2478.           req=req 'the entire ['pen3'C'def']onference? ('
  2479.           IF WORDS(lynes.1)>2 THEN tst='cqt'
  2480.           ELSE tst='cq'
  2481.           DO WHILE POS(stemp,UPPER(tst))=0
  2482.             stemp=getinput(1 1 req||tst') >')
  2483.           END
  2484.           IF stemp='T' THEN
  2485.             DO
  2486.               SAY CR
  2487.               SAY pen3 forthline||def||CR
  2488.               SAY 'Skipping messages associated with this message...'CR
  2489.               SAY CR
  2490.               DO i=lastread.msgdir TO lstwrt
  2491.                 IF msglist.i>1 THEN msglist.i=0
  2492.               END
  2493.               skipsubj.0=skipsubj.0+1
  2494.               sksb=skipsubj.0
  2495.               skipsubj.sksb=forthline
  2496.             END
  2497.           ELSE IF stemp='C' THEN
  2498.             DO
  2499.               SAY pen3'Skipping to the last message in the'def msg.msgdir pen3'conference.'def||CR
  2500.               lastread.msgdir=lstwrt-1
  2501.               lw=lstwrt-1
  2502.               msglist.lw=0
  2503.               msglist.lstwrt=1
  2504.               LEAVE mess
  2505.             END
  2506.         END
  2507.       ELSE IF msgcom='K' THEN
  2508.         DO
  2509.           IF level>sysoplevel | name=WORD(lynes.2,2) THEN
  2510.             DO
  2511.               IF getinput(1 1 'Really delete' arg'? (Ny) > ')='Y' THEN
  2512.                 DO
  2513.                   IF DELETE(arg)=1 THEN
  2514.                     SAY pen3||arg||def' has been deleted.'CR
  2515.                   grand=grand-1
  2516.                   msg.msgdir.0=msg.msgdir.0-1
  2517.                 END
  2518.             END
  2519.         END
  2520.       ELSE IF msgcom='O' THEN   /* go back and read original */
  2521.         DO
  2522.           IF WORDS(lynes.3)>3 THEN
  2523.             DO
  2524.               temp=WORD(lynes.3,4)
  2525.               arg=dirname'/'temp
  2526.             END
  2527.           ELSE SAY 'This is the original message.'CR
  2528.         END
  2529.       ELSE IF msgcom='R' THEN
  2530.         DO
  2531.           IF thread~='' & marknum='' THEN
  2532.             DO
  2533.               li='Read the replies to this message before answering? (nY) > '
  2534.               IF getinput(1 1 li)~='N' THEN
  2535.                 DO
  2536.                   n=late.0+1
  2537.                   late.0=n
  2538.                   late.n=msgstatus
  2539.                   late.n.0=arg
  2540.                   ITERATE msgloop2
  2541.                 END
  2542.             END
  2543.           CALL do_reply(mess)
  2544.         END
  2545.       ELSE IF arg~=savearg THEN /* Continue */
  2546.         DO
  2547.           msgcom='A'
  2548.           arg=savearg
  2549.         END
  2550.     END
  2551.     IF thread~='' THEN
  2552.       DO
  2553.         thread=''
  2554.         msgstatus=msgstatus+1
  2555.       END
  2556.   END
  2557.   IF msgstatus>0 THEN
  2558.     DO
  2559.       IF msgstatus>1 THEN msgstatus=msgstatus-1
  2560.       CALL do_late()
  2561.     END
  2562. END
  2563. msgstatus=0
  2564. CALL do_late()
  2565. DROP msglist. skipsubj. late.
  2566. IF quietflag~=1 THEN nonstop=0
  2567. RETURN
  2568.  
  2569.  
  2570. do_late:
  2571. DO lt=1 TO late.0
  2572.   IF late.lt='' THEN ITERATE lt
  2573.   IF msgstatus<=late.lt THEN
  2574.     DO
  2575.       SAY CR
  2576.       SAY bak2' Reviewing message marked for reply...'def||CR
  2577.       late.lt=''
  2578.       CALL readlines(late.lt.0 1)
  2579.       CALL seelines(2)
  2580.       ps='Reply to this message? (nY) > '
  2581.       IF getinput(1 1 ps)~='N' THEN CALL do_reply(0)
  2582.     END
  2583. END
  2584. RETURN
  2585.  
  2586.  
  2587. do_reply:
  2588. ARG mes
  2589. msgnum=WORD(lynes.1,2)
  2590. forthline=lynes.4
  2591. IF editor('REPLY' WORD(lynes.2,2) msgnum) THEN /* reply */
  2592.   DO
  2593.     savearg2=arg
  2594.     arg=dirname'/'WORD(lynes.3,4)
  2595.     IF EXISTS(arg) THEN
  2596.       DO
  2597.         IF readlines(arg 1) THEN BREAK
  2598.         xmsg=countcheck(bbspath'Numbers/LastMessage'msgdir mes)
  2599.         IF WORDS(lynes.1)>3 THEN lynes.1=lynes.1 xmsg
  2600.         ELSE lynes.1=lynes.1'   Reply' xmsg
  2601.         CALL DELAY(28)    /* allow 1/2 sec for read to close */
  2602.         CALL savelines(arg)
  2603.       END
  2604.     arg=savearg2
  2605.   END
  2606. RETURN
  2607.  
  2608.  
  2609. showmarked:
  2610. ARG ff .
  2611. IF WORDS(data.24)<1 THEN RETURN
  2612. fline='These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'
  2613. IF ff THEN
  2614.   DO
  2615.     SAY CR
  2616.     SAY pen6||fline||def||CR
  2617.   END
  2618. tempkk=data.24
  2619. DO i=1 TO WORDS(tempkk)
  2620.   tempk=WORD(tempkk,i)
  2621.   PARSE VAR tempk kdir'/'kmsg
  2622.   line=RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference'
  2623.   IF EXISTS(msgpath||tempk) THEN
  2624.     DO
  2625.       IF ff THEN SAY line'.'CR
  2626.       ELSE fline=fline'0A'x||line'.'
  2627.     END
  2628.   ELSE
  2629.     DO
  2630.       line=line 'is missing.'
  2631.       IF ff THEN SAY line||CR
  2632.       ELSE fline=fline'0A'x||line
  2633.       data.24=DELWORD(data.24,FIND(data.24,tempk),1)
  2634.     END
  2635. END
  2636. IF ff THEN
  2637.   DO
  2638.     CALL waiting()
  2639.     SAY CR
  2640.   END
  2641. ELSE
  2642.   DO
  2643.     IF writeopen(bbspath'EmailFiles/'name'/Marked')=0 THEN RETURN
  2644.     CALL WRITELN(f,fline)
  2645.     CALL CLOSE(f)
  2646.   END
  2647. RETURN
  2648.  
  2649.  
  2650. killmark:
  2651. PARSE ARG kdir kmsg .
  2652. IF data.24='' THEN RETURN
  2653. markword=FIND(data.24,kdir'/'kmsg)
  2654. IF markword>0 THEN data.24=STRIP(DELWORD(data.24,markword,1))
  2655. RETURN
  2656.  
  2657.  
  2658. readmarked:
  2659. mrknum=WORDS(data.24)
  2660. IF mrknum=0 THEN RETURN
  2661. SAY 'Reading only messages addressed to you...'CR
  2662. mrklist=data.24
  2663. msgcom=''
  2664. DO rmki=1 TO mrknum WHILE msgcom~='Q'
  2665.   tempk=WORD(mrklist,rmki)
  2666.   PARSE VAR tempk mkdir'/'mkmsg .
  2667.   IF ~EXISTS(msgpath||tempk) THEN
  2668.     DO
  2669.       CALL killmark(mkdir mkmsg)
  2670.       SAY CR
  2671.       SAY 'Message number' mkmsg 'in the' msg.mkdir 'conference is missing!'CR
  2672.       SAY CR
  2673.       ITERATE rmki
  2674.     END
  2675.   msgdir=mkdir
  2676.   savelast=lastread.msgdir
  2677.   CALL readmsg(1 mkmsg)
  2678.   IF mkmsg>savelast THEN lastread.msgdir=mkmsg
  2679.   ELSE lastread.msgdir=savelast
  2680. END
  2681. CALL saveData(1)
  2682. RETURN
  2683.  
  2684.  
  2685. sortnumbers:
  2686. PARSE ARG slist
  2687. IF STRIP(slist)='' THEN RETURN ''
  2688. sorted.=''
  2689. oldest=999999
  2690. newest=0
  2691. newlist=''
  2692. DO si=1 TO WORDS(slist)
  2693.   testword=WORD(slist,si)
  2694.   IF ~DATATYPE(testword,'W') THEN
  2695.     DO
  2696.       testpos=LASTPOS('.',testword)
  2697.       IF testpos>0 THEN tempnum=SUBSTR(testword,testpos+1)
  2698.       ELSE
  2699.         DO
  2700.           newlist=testword newlist
  2701.           ITERATE si
  2702.         END
  2703.     END
  2704.   ELSE tempnum=testword/1
  2705.   IF sorted.tempnum='' THEN
  2706.     DO
  2707.       sorted.tempnum=testword
  2708.       sorted.tempnum.0=1
  2709.       IF DATATYPE(tempnum,'W') THEN
  2710.         DO
  2711.           IF tempnum>newest THEN newest=tempnum
  2712.           IF tempnum<oldest THEN oldest=tempnum
  2713.         END
  2714.     END
  2715.   ELSE newlist=newlist testword
  2716. END
  2717. IF oldest~=999999 & newest~=0 THEN
  2718.   DO si=oldest TO newest
  2719.     IF sorted.si.0=1 THEN newlist=newlist sorted.si
  2720.   END
  2721. DROP sorted. oldest newest
  2722. RETURN STRIP(newlist)
  2723.  
  2724.  
  2725. readmail:
  2726. ARG fromenu .
  2727. CALL postuser(3)
  2728. replysubj=''
  2729. IF fromenu THEN
  2730.   DO
  2731.     temp=UPPER(arg)
  2732.     arg=''
  2733.     IF temp~='F' & temp~='T' & temp~='W' THEN
  2734.       DO
  2735.         line='Find Email ['pen3'F'def']rom You ['pen3'T'def']o You or ['pen3'W'def']rite New Email (ftw) > 'def
  2736.         temp=getinput(1 1 line)
  2737.         CALL cleanline(0)
  2738.       END
  2739.     IF temp='W' THEN
  2740.       DO
  2741.         CALL editor('MAIL')
  2742.         RETURN
  2743.       END
  2744.     ELSE IF temp='F' THEN
  2745.       DO
  2746.         firsteditline=0
  2747.         picklist.=''
  2748.         picklist.0=0
  2749.         IF getinput(1 1 'Check ALL users? (nY) > ')='N' THEN
  2750.           DO
  2751.             picklist.1=getinput(1 0 'Check EMail From' name 'To Who? > ')
  2752.             picklist.1=SPACE(STRIP(UPPER(picklist.1)),1,'_')
  2753.             picklist.1=COMPRESS(picklist.1,'.,:/*#?^ ')
  2754.             IF picklist.1='' THEN RETURN
  2755.             IF FIND(userlist,picklist.1)=0 THEN
  2756.               DO
  2757.                 SAY '***'pen3 picklist.1 def'does not exist!'||CR
  2758.                 picklist.0=0
  2759.                 RETURN
  2760.               END
  2761.             fmaillist=SHOWDIR(bbspath'EMail/'picklist.1)
  2762.             DO ej=1 TO WORDS(fmaillist)
  2763.               ejname=WORD(fmaillist,ej)
  2764.               uname=ejname
  2765.               caret=LASTPOS('.',uname)
  2766.               IF caret>2 THEN uname=LEFT(uname,caret-1)
  2767.               IF uname=name THEN
  2768.                 DO
  2769.                   arg=bbspath'EMail/'picklist.1'/'ejname
  2770.                   IF EXISTS(arg) THEN
  2771.                     DO
  2772.                       pklst=picklist.0+1
  2773.                       picklist.pklst=picklist.1
  2774.                       picklist.pklst.0=ejname
  2775.                       picklist.0=pklst
  2776.                     END
  2777.                 END
  2778.             END
  2779.             IF picklist.0=0 THEN SAY 'No Email FROM you was found.'||CR
  2780.             ELSE
  2781.               DO
  2782.                 SAY pen3'You have the following Email pending:'def||CR
  2783.                 pickcheck=1
  2784.                 DO WHILE pickcheck~=0
  2785.                   pickcheck=pickfromlist()
  2786.                   IF pickcheck~=0 THEN
  2787.                     DO
  2788.                       firsteditline=5
  2789.                       IF level>sysoplevel THEN firsteditline=1
  2790.                       CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
  2791.                       IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
  2792.                         picklist.pickcheck='- KILLED -'
  2793.                     END
  2794.                 END
  2795.               END
  2796.           END
  2797.         ELSE
  2798.           DO
  2799.             users=WORDS(userlist)
  2800.             SAY pen3'Scanning'def users pen3'email directories...'def||CR
  2801.             SAY pen3' - To ABORT, press CTRL-E -'def||CR
  2802.             DO wi=1 TO users
  2803.               CALL busywait(60 wi users)
  2804.               fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,wi))
  2805.               DO ej=1 TO WORDS(fmaillist)
  2806.                 ejname=WORD(fmaillist,ej)
  2807.                 uname=ejname
  2808.                 caret=LASTPOS('.',uname)
  2809.                 IF caret>2 THEN uname=LEFT(uname,caret-1)
  2810.                 IF uname=name THEN
  2811.                   DO
  2812.                     arg=bbspath'EMail/'WORD(userlist,wi)'/'ejname
  2813.                     IF EXISTS(arg) THEN
  2814.                       DO
  2815.                         pklst=picklist.0+1
  2816.                         picklist.pklst=WORD(userlist,wi)
  2817.                         picklist.pklst.0=ejname
  2818.                         picklist.0=pklst
  2819.                       END
  2820.                   END
  2821.               END
  2822.               IF wi=999999 THEN RETURN
  2823.             END
  2824.             CALL busywait(4 0)
  2825.             IF picklist.0=0 THEN SAY lineup'No Email FROM you was found.                  'CR
  2826.             ELSE
  2827.               DO
  2828.                 SAY pen3'You have Email pending to the following users:'def||CR
  2829.                 pickcheck=1
  2830.                 DO WHILE pickcheck~=0
  2831.                   pickcheck=pickfromlist()
  2832.                   IF pickcheck~=0 THEN
  2833.                     DO
  2834.                       firsteditline=5
  2835.                       IF level>sysoplevel THEN firsteditline=1
  2836.                       CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
  2837.                       IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
  2838.                         picklist.pickcheck='- KILLED -'
  2839.                     END
  2840.                 END
  2841.               END
  2842.           END
  2843.         DROP picklist.
  2844.         RETURN
  2845.       END
  2846.     ELSE IF temp='T' THEN BREAK
  2847.     ELSE RETURN
  2848.   END
  2849. SAY 'Checking your mailbox...'CR
  2850. nomail=1
  2851. CALL MAKEDIR(bbspath'EMail/'name)
  2852. mailist=sortnumbers(SHOWDIR(bbspath'Email/'name))
  2853. IF WORDS(mailist)=0 THEN
  2854.   DO
  2855.     SAY lineup'Your mailbox is empty.  'CR
  2856.     SAY CR
  2857.     RETURN
  2858.   END
  2859. line=WORDS(mailist)
  2860. IF line>1 THEN line=line 'letters'
  2861. ELSE line=line 'letter'
  2862. line=line 'waiting.'
  2863. SAY line||CR
  2864. DO ii=1 TO WORDS(mailist)
  2865.   SAY 'Email:' pen3||WORD(mailist,ii)||def||CR
  2866. END
  2867. IF ~fromenu THEN
  2868.   IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN
  2869. onename=''
  2870. IF WORDS(mailist)>3 THEN
  2871.   DO
  2872.     IF getinput(1 1 'Read all private mail? (nY) > ')='N' THEN
  2873.       DO
  2874.         onename=getinput(1 0 'Read ONLY private mail from? > ')
  2875.         onename=SPACE(STRIP(UPPER(onename)),1,'_')
  2876.         onename=COMPRESS(onename,'.,:/*#?^ ')
  2877.         IF onename='' THEN RETURN
  2878.         IF FIND(userlist,onename)=0 & picklist.1~='BBBBS' THEN
  2879.           DO
  2880.             SAY '***'pen3 onename def'does not exist!'||CR
  2881.             RETURN
  2882.           END
  2883.       END
  2884.   END
  2885. DO letter=1 TO WORDS(mailist)
  2886.   readname=WORD(mailist,letter)
  2887.   uname=readname
  2888.   caret=LASTPOS('.',uname)
  2889.   IF caret>2 THEN uname=LEFT(uname,caret-1)
  2890.   IF onename~='' & onename~=uname THEN ITERATE letter
  2891.   arg=bbspath'Email/'name'/'readname        /* user has mail! */
  2892.   CALL readlines(arg 1)
  2893.   delnum=WORD(lynes.1,2)
  2894.   CALL seelines(1)
  2895.   nomail=0
  2896.   nonstop=0
  2897.   mailfile=''
  2898.   IF UPPER(WORD(lynes.1,3))='FILE:' THEN mailfile=WORD(lynes.1,4)
  2899.   ELSE IF UPPER(WORD(lynes.2,3))='FILE:' THEN mailfile=WORD(lynes.2,4)
  2900.   IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' THEN
  2901.     DO
  2902.       IF LEFT(RIGHT(mailfile,4),1)~='.' & LEFT(readname,6)='BBBBS.' THEN
  2903.         DO
  2904.           SAY CR
  2905.           SAY pen3'The attached file is unarchived and may be incomplete.'CR
  2906.           SAY 'If the archiver is still building this file, downloading will fail.'def||CR
  2907.           IF getinput(1 1 'Do you want to try to download it anyway? (Ny) > ')~='Y' THEN ITERATE letter
  2908.           SAY CR
  2909.         END
  2910.       curdir=PRAGMA('D')
  2911.       CALL setdir(bbspath'EmailFiles/'name)
  2912.       filesize=WORD(STATEF(mailfile),2)
  2913.       IF getinput(1 1 ' Attached file:' pen3||mailfile||def 'is' pen3||filesize||def 'bytes.  Download now? (nY) > ')~='N' THEN
  2914.         DO
  2915.           savearg=arg
  2916.           allargs=bbspath'EmailFiles/'name'/'mailfile
  2917.           DO WHILE dload2()=1
  2918.           END
  2919.           arg=savearg
  2920.           CALL readlines(arg 1)
  2921.         END
  2922.       CALL setdir(curdir)
  2923.     END
  2924.   IF readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' & LEFT(readname,6)~='BBBBS.' THEN
  2925.     DO
  2926.       tempchar='A'
  2927.       DO WHILE tempchar='A'
  2928.         tempchar=getinput(1 1 '['pen3'A'def']gain  ['pen3'C'def']ontinue  ['pen3'R'def']eply (acR) > ')
  2929.         IF tempchar='' THEN tempchar='R'
  2930.         IF tempchar='A' THEN CALL seelines(1)
  2931.       END
  2932.       IF tempchar='R' THEN
  2933.         DO
  2934.           IF WORDS(lynes.4)<2 THEN replysubj='NONE'
  2935.           ELSE replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2))
  2936.           CALL editor('MAIL' uname)
  2937.           replysubj=''
  2938.         END
  2939.     END
  2940.   IF LEFT(readname,6)~='BBBBS.' THEN
  2941.     DO
  2942.       tempchar='A'
  2943.       DO WHILE tempchar='A'
  2944.         tempchar=getinput(1 1 'Forward mail from'pen3 uname def'to other users? (aNy) > ')
  2945.         IF tempchar='A' THEN CALL seelines(1)
  2946.       END
  2947.       IF tempchar='Y' THEN
  2948.         DO
  2949.           IF selectchosen(1 pen3'Forward Email To: 'def)=0 THEN
  2950.             DO ei=1 TO thechosen.0 WHILE thechosen.ei~=''
  2951.               CALL MAKEDIR(bbspath'EMail/'thechosen.ei)
  2952.               forwardarg=bbspath'Email/'thechosen.ei'/'readname
  2953.               ADDRESS COMMAND 'C:COPY' bbspath'Email/'name'/'readname forwardarg
  2954.               CALL readlines(forwardarg 1)
  2955.               lynes.1=lynes.1'  Forwarded to you by' name TIME('C') DATE()
  2956.               CALL DELETE(forwardarg)
  2957.               CALL savelines(forwardarg)
  2958.               IF WORDS(lynes.2)>3 THEN
  2959.                 DO
  2960.                   forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4)
  2961.                   IF EXISTS(forname) THEN
  2962.                     DO
  2963.                       CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ei)
  2964.                       ADDRESS COMMAND 'C:COPY' forname bbspath'EmailFiles/'thechosen.ei
  2965.                     END
  2966.                 END
  2967.               line='Mail' pen3||readname||def 'forwarded to' pen3||thechosen.ei||def
  2968.               IF emailonline>=0 THEN emailonline=emailonline+1
  2969.               CALL send2log(line)
  2970.               SAY line||CR
  2971.             END
  2972.         END
  2973.     END
  2974.   tempchar=''
  2975.   tempstr='Delete the email ('pen3||delnum||def') from'pen3 uname def'that you just read?'
  2976.   IF mailfile='' THEN tempchar=getinput(1 1 tempstr '(nqY) > ')
  2977.   ELSE
  2978.     DO WHILE tempchar~='N' & tempchar~='Q' & tempchar~='Y'
  2979.       tempchar=getinput(1 1 tempstr '(nqy) > ')
  2980.     END
  2981.   IF tempchar='Q' THEN
  2982.     DO
  2983.       IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
  2984.         DO
  2985.           readname=''
  2986.           uname=''
  2987.           RETURN
  2988.         END
  2989.     END
  2990.   ELSE IF tempchar~='N' THEN
  2991.     DO
  2992.       dirname=bbspath'Email/'name'/'
  2993.       nodelete=0
  2994.       IF bbsprefs.14=1 & name~=sysop & uname~=sysop & WORD(lynes.2,2)~='BBBBS' & WORD(lynes.2,2)~=sysop & WORD(lynes.3,2)~=sysop THEN
  2995.         nodelete=1
  2996.       IF nodelete THEN
  2997.         ADDRESS COMMAND 'C:Copy' dirname||readname bbspath'Email/'sysop
  2998.       ELSE emailonline=emailonline-1
  2999.       CALL DELETE(dirname||readname)
  3000.       tempstr='Old email'
  3001.       IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN
  3002.         DO
  3003.           IF nodelete THEN
  3004.             ADDRESS COMMAND 'C:Copy' bbspath'EmailFiles/'name'/'mailfile bbspath'EmailFiles/'sysop
  3005.           CALL DELETE(bbspath'EmailFiles/'name'/'mailfile)
  3006.           CALL DELETE(bbspath'EmailFiles/'name'/'mailfile'.xdl')
  3007.           tempstr=tempstr 'and attached file'
  3008.         END
  3009.       tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!'
  3010.       SAY tempstr||CR
  3011.       IF tempchar='Q' THEN
  3012.         IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
  3013.           DO
  3014.             readname=''
  3015.             uname=''
  3016.             RETURN
  3017.           END
  3018.     END
  3019.   ELSE IF LEFT(readname,3)='MSG' & level>sysoplevel THEN
  3020.     DO
  3021.       ii=LEFT(readname,POS('.',readname)-1)
  3022.       ii=SUBSTR(ii,4)%1
  3023.       IF getinput(1 1 'Move this message back to the' msg.ii 'conference? (nY) > 'def)~='N' THEN
  3024.         DO
  3025.           temp=TRANSLATE(readname,'/','.')
  3026.           temp=SUBSTR(temp,4)
  3027.           lynes.1='!!'STRIP(lynes.1)
  3028.           edtype=''
  3029.           CALL savelines(msgpath||temp)
  3030.           CALL DELETE(bbspath'Email/'name'/'readname)
  3031.         END
  3032.     END
  3033.   ELSE IF LEFT(readname,3)~='MSG' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' THEN
  3034.     DO
  3035.       arg=bbspath'Email/'name'/'readname
  3036.       CALL readlines(arg 1)
  3037.       IF WORDS(lynes.5)<7 THEN
  3038.         DO
  3039.           lynes.5=lynes.5'  (Rcvd)' DATE('W') DATE() TIME('C')
  3040.           CALL DELETE(arg)
  3041.           CALL savelines(arg)
  3042.           SAY 'Email has been marked as received.'CR
  3043.         END
  3044.     END
  3045.   CALL checktime()
  3046.   readname=''
  3047.   uname=''
  3048.   arg=''
  3049. END
  3050. IF nomail THEN
  3051.   DO
  3052.     SAY 'No mail was found.'CR
  3053.     CALL waiting()
  3054.   END
  3055. CALL setdir(libpath||dirs.1)
  3056. thechosen.=''
  3057. RETURN
  3058.  
  3059.  
  3060. selectchosen:
  3061. PARSE ARG startat selectline
  3062. IF startat<2 THEN thechosen.=''
  3063. line='Enter list of comma separated user names'
  3064. IF level>sysoplevel THEN line=line 'or ALL'
  3065. SAY line||CR
  3066. thechosen.startat=getinput(1 0 selectline' ')
  3067. IF STRIP(thechosen.startat)='' THEN RETURN 1
  3068. thechosen.startat=SPACE(thechosen.startat,1,'_')
  3069. thechosen.0=startat
  3070. IF level>sysoplevel & thechosen.startat='ALL' THEN
  3071.   thechosen.startat=SHOWDIR(bbspath'Users','F',',')
  3072. IF POS(',',thechosen.startat)>0 THEN
  3073.   DO
  3074.     temp=TRANSLATE(thechosen.startat,' ',',')
  3075.     thechosen.0=thechosen.0+WORDS(temp)-1
  3076.     DO ei=1 TO WORDS(temp)
  3077.       eii=startat+ei-1
  3078.       thechosen.eii=STRIP(WORD(temp,ei))
  3079.     END
  3080.   END
  3081. DO ei=startat TO thechosen.0
  3082.   DO WHILE FIND(userlist,thechosen.ei)=0
  3083.     IF thechosen.ei~='' THEN
  3084.       DO
  3085.         IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN
  3086.           DO
  3087.             thechosen.ei=sysop
  3088.             ITERATE ei
  3089.           END
  3090.         CALL loadcourtesy()
  3091.         IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei
  3092.       END
  3093.     SAY thechosen.ei 'not found! Enter that name again or press RETURN.'CR
  3094.     thechosen.ei=getinput(1 0 pen3||selectline' 'def)
  3095.     IF thechosen.ei='' THEN
  3096.       DO
  3097.         IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
  3098.           CALL showuserlist()
  3099.         ITERATE ei
  3100.       END
  3101.     thechosen.ei=SPACE(thechosen.ei,1,'_')
  3102.   END
  3103. END
  3104. RETURN 0
  3105.  
  3106.  
  3107. countcheck:
  3108. PARSE ARG fname' 'cknum' '.
  3109. IF ~EXISTS(fname) THEN
  3110.   DO
  3111.     IF cknum=0 THEN RETURN 0
  3112.     IF ~writeopen(fname) THEN RETURN 0
  3113.     CALL WRITELN(f,cknum)
  3114.     CALL CLOSE(f)
  3115.     RETURN cknum
  3116.   END
  3117. IF ~readopen(fname) THEN RETURN cknum
  3118. retval=STRIP(READLN(f))
  3119. CALL CLOSE(f)
  3120. IF ~DATATYPE(retval,'W') THEN retval=0
  3121. IF ~DATATYPE(cknum,'W') THEN cknum=0
  3122. IF retval<cknum THEN
  3123.   DO
  3124.     IF writeopen(fname) THEN
  3125.       DO
  3126.         CALL WRITELN(f,cknum)
  3127.         CALL CLOSE(f)
  3128.         RETURN cknum
  3129.       END
  3130.   END
  3131. RETURN retval
  3132.  
  3133.  
  3134. pickfromlist:
  3135. DO pfl=1 TO picklist.0 BY 3
  3136.   pfl2=pfl+1
  3137.   pfl3=pfl+2
  3138.   pfline=pen3||RIGHT(pfl,3)||def LEFT(picklist.pfl,21)
  3139.   IF picklist.pfl2~='' THEN
  3140.     pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(picklist.pfl2,21)
  3141.   IF picklist.pfl3~='' THEN
  3142.     pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(picklist.pfl3,21)
  3143.   SAY pfline||CR
  3144. END
  3145. emnum=getinput(1 0 pen3'Select Email Number > 'def)
  3146. IF ~DATATYPE(emnum,'W') | emnum<1 | emnum>picklist.0 THEN RETURN 0
  3147. RETURN emnum
  3148.  
  3149.  
  3150. sysED:
  3151. IF level<99 THEN RETURN
  3152. arg=getinput(0 0 'Textfile To Edit: ')
  3153. IF arg='' THEN RETURN
  3154. CALL bbsED(1 arg)
  3155. RETURN
  3156.  
  3157.  
  3158. bbsED:
  3159. PARSE ARG firstedit editarg .
  3160. notchanged=1
  3161. IF readlines(editarg 1) THEN RETURN 1
  3162. finfo=STATEF(editarg)
  3163. IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
  3164. ELSE finfo=''
  3165. SAY CR
  3166. SAY '                   'pen3'Entering the EDITOR module..'def||CR
  3167. SAY CR
  3168. count=1
  3169. DO edloop=1
  3170.   IF edcom='S' & bbsprefs.5 THEN  /* spell check */
  3171.     DO
  3172.       SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def||CR
  3173.       CALL DELETE(scratch'/SpellFile')
  3174.       CALL savelines(scratch'/SpellFile')
  3175.       curdir=PRAGMA('D')
  3176.       CALL setdir(spellpath)
  3177.       CALL SpellChk.rexx(scratch'/SpellFile')
  3178.       CALL setdir(curdir)
  3179.     END
  3180.   ELSE
  3181.     DO
  3182.       IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
  3183.       IF edcom~='L' THEN count=count-linesperpage
  3184.       IF count>=lynes.0 | count<1 THEN count=1
  3185.       startcount=count
  3186.       DO i=startcount TO lynes.0+1
  3187.         IF ((i+1-startcount)//linesperpage)=0 THEN
  3188.           DO
  3189.             pline='                 ['pen3'E'def']dit'
  3190.             pline=pline '  ['pen3'RETURN'def']=Continue '
  3191.             edcom=getinput(1 1 pline)
  3192.             IF edcom~='' THEN LEAVE i
  3193.             CALL cleanline(1)
  3194.           END
  3195.         SAY pen3||RIGHT(i,3)||def lynes.i||CR
  3196.         count=count+1
  3197.       END
  3198.     END
  3199.   CALL checktime()
  3200.   SAY lineup'     ['pen3'A'def']ppend ['pen3'C'def']ut     ['pen3'I'def']nsert  ['pen3'K'def']ill       ['pen3'?'def'] Help'CR
  3201.   pline='     ['pen3'L'def']ist   ['pen3'P'def']aste   ['pen3'R'def']eplace'
  3202.   IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
  3203.   pline=pline '['pen3'U'def']pload-Text > '
  3204.   edcom=getinput(1 0 pline)
  3205.   IF edcom='Q' | edcom='X' THEN edcom=''
  3206.   IF edcom='?' THEN
  3207.     DO
  3208.       SAY CR
  3209.       SAY '                   Editor Help'CR
  3210.       SAY '----------------------------------------------------------'CR
  3211.       SAY '    an empty RETURN tells the editor you are done editing.'CR
  3212.       SAY ' 7  edits line number 7, if it exists.'CR
  3213.       SAY ' a  Append text to this file.'CR
  3214.       SAY ' c  Cut selected line(s) of text to buffer.'CR
  3215.       SAY ' i  Insert blank line.'CR
  3216.       SAY ' k  Kill (delete) this file.'CR
  3217.       SAY ' l  List this file from selected line.'CR
  3218.       SAY ' p  Paste buffer contents to selected line number.'CR
  3219.       SAY ' r  Replace a phrase or line of text.'CR
  3220.       SAY ' s  Spellcheck this file.'CR
  3221.       SAY ' u  Upload a textfile to append to this file.'CR
  3222.       SAY '----------------------------------------------------------'CR
  3223.       SAY CR
  3224.       OPTIONS PROMPT ''
  3225.       PULL
  3226.     END
  3227.   IF edcom='K' THEN
  3228.     DO
  3229.       junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
  3230.       IF junk='Y' THEN
  3231.         DO
  3232.           IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'CR
  3233.           IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
  3234.             DO
  3235.               IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
  3236.                 SAY WORD(lynes.2,4) 'DELETED.'CR
  3237.             END
  3238.           RETURN 2
  3239.         END
  3240.     END
  3241.   IF edcom='' THEN
  3242.     DO
  3243.       SAY '                   'pen3'Leaving the EDITOR module.'def||CR
  3244.       IF notchanged THEN RETURN 0
  3245.       IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
  3246.         RETURN 1
  3247.       CALL DELETE(editarg)
  3248.       IF savelines(editarg) THEN RETURN 1
  3249.       CALL DELAY(28)
  3250.       IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
  3251.       SAY pen3'                        Changes saved.'def||CR
  3252.       RETURN 0
  3253.     END
  3254.   ELSE IF edcom='C' THEN  /* Cut */
  3255.     DO
  3256.       firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
  3257.       IF firstnum='' THEN ITERATE edloop
  3258.       dash=POS('-',firstnum)
  3259.       IF dash>0 THEN
  3260.         DO
  3261.           lastnum=STRIP(SUBSTR(firstnum,dash+1))
  3262.           firstnum=STRIP(LEFT(firstnum,dash-1))
  3263.         END
  3264.       ELSE lastnum=firstnum
  3265.       IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN
  3266.         DO
  3267.           junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
  3268.           ITERATE edloop
  3269.         END
  3270.       IF lastnum>lynes.0 THEN lastnum=lynes.0
  3271.       IF firstnum<firstedit THEN
  3272.         DO
  3273.           SAY '*** You are not authorized to delete that line!'CR
  3274.           SAY CR
  3275.           ITERATE edloop
  3276.         END
  3277.       IF firstnum>lastnum THEN
  3278.         DO
  3279.           SAY '*** Input error!  First number larger than last number.'CR
  3280.           ITERATE edloop
  3281.         END
  3282.       notchanged=0
  3283.       numdiff=lastnum+1-firstnum
  3284.       pasted.=''
  3285.       pasted.0=numdiff
  3286.       k=0
  3287.       DO i=firstnum TO lynes.0
  3288.         j=i+numdiff
  3289.         k=k+1
  3290.         IF k<=numdiff THEN pasted.k=lynes.i
  3291.         lynes.i=lynes.j
  3292.         lynes.j=''
  3293.       END
  3294.       lynes.0=lynes.0-numdiff
  3295.       count=1
  3296.     END
  3297.   ELSE IF edcom='A' THEN  /* append */
  3298.     DO
  3299.       CALL writebuffer(scratch'/EditorFile')
  3300.       notchanged=0
  3301.     END
  3302.   ELSE IF edcom='U' THEN  /* Upload a textfile to append */
  3303.     DO
  3304.       CALL txup(1)
  3305.       notchanged=0
  3306.     END
  3307.   ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN
  3308.     DO
  3309.       IF DATATYPE(edcom,'W') THEN
  3310.         DO
  3311.           ednum=edcom
  3312.           edcom='R'
  3313.         END
  3314.       ELSE
  3315.         DO
  3316.           line=pen3'   '
  3317.           IF edcom='L' | edcom='P' THEN line=line'Starting '
  3318.           line=line'Line Number? > 'def
  3319.           ednum=getinput(1 0 line)
  3320.         END
  3321.       IF ~DATATYPE(ednum,'W') THEN ITERATE edloop
  3322.       IF ednum>(lynes.0+1) THEN ITERATE edloop
  3323.       IF edcom='L' THEN
  3324.         DO
  3325.           count=ednum
  3326.           ITERATE edloop
  3327.         END
  3328.       IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN
  3329.         DO
  3330.           IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN
  3331.             DO
  3332.               filenum=STRIP(WORD(lynes.1,2))
  3333.               num=files.filenum.0
  3334.               keywords=edkeywords(editarg)
  3335.               lynes.1=LEFT(lynes.1,21) keywords
  3336.               alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32))
  3337.               savefileflag=1
  3338.               notchanged=0
  3339.               ITERATE edloop
  3340.             END
  3341.         END
  3342.       IF ednum<firstedit THEN
  3343.         DO
  3344.           SAY '*** You are not authorized to alter that line!'CR
  3345.           SAY CR
  3346.           ITERATE edloop
  3347.         END
  3348.       IF edcom='R' THEN   /* replace */
  3349.         DO
  3350.           SAY '   Now reads:'CR
  3351.           SAY pen3||RIGHT(ednum,2)||def lynes.ednum||CR
  3352.           OPTIONS PROMPT pen3'........Search text? >'def
  3353.           PARSE PULL stext
  3354.           IF LENGTH(stext)=0 THEN
  3355.             DO
  3356.               IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
  3357.                 ITERATE edloop
  3358.               lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
  3359.               notchanged=0
  3360.               ITERATE edloop
  3361.             END
  3362.           found=POS(UPPER(stext),UPPER(lynes.ednum))
  3363.           IF found=0 THEN
  3364.             DO
  3365.               SAY CR
  3366.               SAY stext' was not found!'CR
  3367.               SAY CR
  3368.               ITERATE edloop
  3369.             END
  3370.           OPTIONS PROMPT pen3'...Replacement text? >'def
  3371.           PARSE PULL rtext
  3372.           lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
  3373.           lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
  3374.           IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN
  3375.             DO
  3376.               PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords
  3377.               PARSE VAR lynes.3 . 'Lib:' libnam
  3378.               filenum=STRIP(filenum)
  3379.               newc=files.filenum.0
  3380.               libnum=finddirnum(libnam)
  3381.               alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4)))
  3382.               alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5)
  3383.               alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12)
  3384.               alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32))
  3385.               savefileflag=1
  3386.             END
  3387.           SAY 'Done.'CR
  3388.           SAY CR
  3389.           notchanged=0
  3390.         END
  3391.       ELSE IF edcom='I' THEN  /* insert */
  3392.         DO
  3393.           DO i=lynes.0 TO ednum BY -1
  3394.             j=i+1
  3395.             lynes.j=lynes.i
  3396.           END
  3397.           lynes.ednum=''
  3398.           notchanged=0
  3399.           lynes.0=lynes.0+1
  3400.           OPTIONS PROMPT pen3||RIGHT(ednum,2)'>'def
  3401.           PARSE PULL lynes.ednum
  3402.         END
  3403.       ELSE IF edcom='P' THEN   /* paste */
  3404.         DO
  3405.           DO i=lynes.0 TO ednum BY -1
  3406.             j=i+pasted.0
  3407.             lynes.j=lynes.i
  3408.           END
  3409.           DO k=1 TO pasted.0
  3410.             kk=ednum+k-1
  3411.             lynes.kk=pasted.k
  3412.           END
  3413.           notchanged=0
  3414.           lynes.0=lynes.0+pasted.0
  3415.         END
  3416.     END
  3417. END
  3418. RETURN 0
  3419.  
  3420.  
  3421. editor:
  3422. toname=''
  3423. msgnum=0
  3424. thechosen.=''
  3425. PARSE ARG edtype toname msgnum .
  3426. IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
  3427. ELSE 
  3428.   DO
  3429.     IF edtype='MSG' THEN
  3430.       DO
  3431.         tempmsgdir=0
  3432.         IF DATATYPE(arg,'W') THEN tempmsgdir=arg
  3433.         IF tempmsgdir>0 & tempmsgdir<=level & msg.tempmsgdir~='' THEN
  3434.           msgdir=tempmsgdir
  3435.         ELSE IF areaselect() THEN RETURN
  3436.       END
  3437.     lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  3438.   END
  3439. IF toname='' THEN
  3440.   DO
  3441.     IF edtype='MAIL' THEN
  3442.       DO
  3443.         CALL selectchosen(1 pen3'Send PRIVATE' edtype lastwrit+1 'To: 'def)
  3444.         toname=thechosen.1
  3445.       END
  3446.     ELSE toname=getinput(1 0 pen3'Post A PUBLIC Message To: 'def)
  3447.   END
  3448. toname=SPACE(toname,1,'_')
  3449. toname=cleanstring(1':'toname)
  3450. IF toname='' | FIND(exclusion,toname)>0 THEN
  3451.   DO
  3452.     IF toname='' & edtype='MSG' THEN toname='ALL'
  3453.     ELSE toname=sysop
  3454.     SAY pen3'*** Re-Addressed to'def toname||CR
  3455.   END
  3456. IF toname~='ALL' THEN
  3457.   DO
  3458.     IF toname='BBBBS' THEN toname=sysop
  3459.     IF FIND(userlist,toname)=0 THEN
  3460.       DO
  3461.         IF courtesy='' THEN CALL loadcourtesy()
  3462.         IF FIND(courtesy,toname)=0 THEN
  3463.           DO
  3464.             SAY CR
  3465.             SAY bak2' 'toname' is not on the user list! 'def||CR
  3466.             IF edtype='MAIL' THEN
  3467.               DO
  3468.                 CALL showuserlist()
  3469.                 RETURN 0
  3470.               END
  3471.             ELSE
  3472.               DO
  3473.                 IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN
  3474.                   DO
  3475.                     IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
  3476.                       CALL showuserlist()
  3477.                     RETURN 0
  3478.                   END
  3479.               END
  3480.           END
  3481.       END
  3482.   END
  3483. IF toname=sysop THEN CALL sound('FEEDBACK')
  3484. ELSE CALL sound('MESSAGE')
  3485. IF edtype='MAIL' THEN
  3486.   DO
  3487.     CALL MAKEDIR(bbspath'EMail/'toname)
  3488.     mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
  3489.   END
  3490. ELSE
  3491.   DO
  3492.     CALL MAKEDIR(msgpath||msgdir)
  3493.     mailname=msgpath||msgdir'/'lastwrit+1
  3494.   END
  3495. lynes.=''
  3496. lynes.0=6
  3497. IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1  /* FILE: filename */
  3498. ELSE lynes.1='  Msg:' lastwrit+1          /* Msg: MSG# REPLY # # ... */
  3499. lynes.2=' From:' name
  3500. IF city~='' THEN lynes.2=lynes.2' - 'city
  3501. lynes.3='   To:' toname                       /*  To: toname   MSG # */
  3502. IF edtype='MAIL' THEN
  3503.   DO
  3504.     IF readopen(bbspath||'Users/'toname) THEN
  3505.       DO
  3506.         CALL READLN(f)
  3507.         CALL READLN(f)
  3508.         temp=READLN(f)
  3509.         CALL CLOSE(f)
  3510.         temp=docity(temp)
  3511.         IF temp~='' THEN lynes.3=lynes.3' - 'temp
  3512.       END
  3513.     IF replysubj='|@NEW@|' THEN
  3514.       DO
  3515.         CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
  3516.         replysubj='Welcome to' bbsname
  3517.       END
  3518.   END
  3519. subj=''
  3520. IF edtype='REPLY' THEN
  3521.   DO
  3522.     subj=SUBSTR(forthline,WORDINDEX(forthline,2))
  3523.     SAY pen3'Subj:'def subj||CR
  3524.     temp=getinput(0 0 'Change the current subject? (Ny) > ')
  3525.     IF LENGTH(temp)>3 THEN subj=temp
  3526.     ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj=''
  3527.   END
  3528. ELSE IF edtype='MAIL' & replysubj~='' THEN subj=replysubj
  3529. IF subj='' THEN
  3530.   DO
  3531.     IF opt='C' THEN subj='FEEDBACK'
  3532.     ELSE
  3533.       DO
  3534.         SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def||CR
  3535.         subj=getinput(0 0 pen3': 'def)
  3536.       END
  3537.   END
  3538. IF LENGTH(subj)>66 THEN subj=LEFT(subj,66)
  3539. IF subj='' THEN subj='?'
  3540. lynes.4=' Subj:' subj
  3541. lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
  3542. IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
  3543. lynes.6=LEFT('',74,'=')
  3544. IF edtype='REPLY' THEN lynes.3=lynes.3'  MSG 'msgnum
  3545. DO i=1 TO lynes.0
  3546.   SAY lynes.i||CR
  3547. END
  3548. CALL writebuffer(scratch'/MessageFile')
  3549. IF savelines(mailname) THEN RETURN 0
  3550. CALL seelines(1)
  3551. IF thechosen.0='' THEN
  3552.   DO
  3553.     thechosen.0=1
  3554.     thechosen.1=toname
  3555.   END
  3556. carbons=thechosen.0+1
  3557. DO FOREVER
  3558.   IF thechosen.0>=carbons THEN
  3559.     DO
  3560.       junk='Copies To:'
  3561.       DO cci=carbons TO thechosen.0
  3562.         junk=junk thechosen.cci
  3563.       END
  3564.       SAY junk||CR
  3565.     END
  3566.   pline=''
  3567.   IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
  3568.   pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead')
  3569.   pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def
  3570.   junk=getinput(1 1 pline)
  3571.   IF junk='E' THEN
  3572.     DO
  3573.       IF level>sysoplevel THEN firstedit=1
  3574.       ELSE firstedit=7
  3575.       IF bbsED(firstedit mailname)=2 THEN RETURN 0
  3576.       junk='R'
  3577.     END
  3578.   ELSE IF edtype='MAIL' & junk='C' THEN
  3579.     DO
  3580.       CALL selectchosen(carbons pen3'Carbon Copies To: 'def)
  3581.       junk='R'
  3582.     END
  3583.   ELSE IF junk='K' THEN
  3584.     DO
  3585.       IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'CR
  3586.       RETURN 0
  3587.     END
  3588.   ELSE IF junk='U' THEN
  3589.     DO
  3590.       CALL txup(0 mailname)
  3591.       junk='R'
  3592.     END
  3593.   IF junk='R' THEN
  3594.     DO
  3595.       CALL readlines(mailname 1)
  3596.       CALL seelines(1)
  3597.       nonstop=0
  3598.     END
  3599.   ELSE BREAK
  3600. END
  3601. IF edtype='MAIL' THEN
  3602.   DO
  3603.     IF replysubj~='' & readname~='' & LEFT(readname,5)~='BBBBS' & uname~='' & uname~='UNAME' THEN
  3604.       DO
  3605.         junk=getinput(1 1 'Attach original mail from' uname'? (nY) > ')
  3606.         IF junk~='N' THEN
  3607.           DO
  3608.             arg=bbspath'Email/'name'/'readname
  3609.             IF ~readlines(arg 1) THEN CALL savelines(mailname)
  3610.           END
  3611.       END
  3612.     junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def)
  3613.     IF junk='Y' THEN
  3614.       DO
  3615.         savearg=arg
  3616.         arg=getinput(0 0 'Filename: ')
  3617.         curdir=PRAGMA('D')
  3618.         CALL MAKEDIR(bbspath'EmailFiles/'toname)
  3619.         CALL setdir(bbspath'EmailFiles/'toname)
  3620.         DO WHILE uload(0)=2
  3621.         END
  3622.         IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN
  3623.           DO
  3624.             CALL readlines(mailname 1)
  3625.             IF arg~='' THEN lynes.1=lynes.1'  FILE: 'arg
  3626.             CALL setdir(curdir)
  3627.             CALL DELETE(mailname)
  3628.             CALL savelines(mailname)
  3629.           END
  3630.         ELSE
  3631.           DO
  3632.             CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
  3633.             SAY pen3'*** Upload failed! ***'def||CR
  3634.           END
  3635.         arg=savearg
  3636.       END
  3637.     totmail=WORD(data.17,2)
  3638.     IF ~DATATYPE(totmail,'W') THEN totmail=1
  3639.     ELSE totmail=totmail+1
  3640.     data.17=WORD(data.17,1)'  'totmail'  'WORD(data.17,3)
  3641.   END
  3642. IF edtype~='MAIL' THEN totwrit.msgdir=totwrit.msgdir+1
  3643. CALL readlines(mailname 1)
  3644. DO ui=1 TO thechosen.0
  3645.   IF thechosen.ui='' THEN ITERATE ui
  3646.   IF ui>1 THEN
  3647.     DO
  3648.       CALL MAKEDIR(bbspath'Email/'thechosen.ui)
  3649.       newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
  3650.       IF ui<carbons THEN lynes.3='   To:' thechosen.ui
  3651.       ELSE
  3652.         DO
  3653.           lynes.1=lynes.1'  (Carbon Copy)'
  3654.           lynes.3='   To:' thechosen.1
  3655.         END
  3656.       CALL savelines(newname)
  3657.       IF WORDS(lynes.1)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN
  3658.         DO
  3659.           CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
  3660.           ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui
  3661.           line2='Copied' WORD(lynes.1,4)
  3662.           SAY line2 'to the' thechosen.ui 'file area.'CR
  3663.           CALL send2log(line2)
  3664.         END
  3665.     END
  3666.   line=edtype':'lastwrit+1 'at' TIME('C') 'to' thechosen.ui
  3667.   IF edtype~='MAIL' THEN
  3668.     DO
  3669.       IF FIND(userlist,thechosen.ui)>0 THEN
  3670.         CALL msgmark(thechosen.ui msgdir lastwrit+1)
  3671.       line=line 'in' msg.msgdir
  3672.     END
  3673.   CALL send2log(line)
  3674.   line=edtype 'Sent To' thechosen.ui
  3675.   IF edtype='MAIL' THEN
  3676.     DO
  3677.       IF emailonline>=0 THEN emailonline=emailonline+1
  3678.     END
  3679.   ELSE
  3680.     DO
  3681.       grand=grand+1
  3682.       IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1
  3683.       ELSE msg.msgdir.0=msg.msgdir.0+1
  3684.       line=line 'in the'pen3 msg.msgdir def'conference.'
  3685.     END
  3686.   SAY line||CR
  3687. END
  3688. IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1)
  3689. ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
  3690. CALL setdir(libpath||dirs.1)
  3691. thechosen.=''
  3692. RETURN 1
  3693.  
  3694.  
  3695. txup:
  3696. PARSE ARG upflg uparg .
  3697. SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
  3698. pline='Are you SURE your file is un-compressed text? (Ny) > '
  3699. IF getinput(1 1 pline)='Y' THEN
  3700.   DO
  3701.     savearg=arg
  3702.     arg='UploadFile'
  3703.     curdir=PRAGMA('D')
  3704.     CALL setdir(scratch)
  3705.     CALL DELETE(arg)
  3706.     CALL DELETE('tempfile1')
  3707.     IF uload(0)=0 THEN
  3708.       DO
  3709.         IF upflg=0 THEN
  3710.           DO
  3711.             ADDRESS COMMAND 'C:copy' uparg 'tempfile1'
  3712.             CALL DELETE(uparg)
  3713.             ADDRESS COMMAND 'C:join tempfile1 UploadFile AS' uparg
  3714.           END
  3715.         ELSE IF upflg=1 THEN
  3716.           DO
  3717.             CALL readlines(arg lynes.0+1)
  3718.             notchanged=0
  3719.           END
  3720.       END
  3721.     CALL setdir(curdir)
  3722.     arg=savearg
  3723.   END
  3724. RETURN
  3725.  
  3726.  
  3727. msgmark:
  3728. PARSE ARG markname markdir markmsg .
  3729. IF OPEN(f,bbspath'Users/'markname,'R')=0 THEN RETURN
  3730. mlines.=''
  3731. DO mi=1
  3732.   temp=READLN(f)
  3733.   IF EOF(f) THEN LEAVE mi
  3734.   mlines.mi=STRIP(temp)
  3735. END
  3736. CALL CLOSE(f)
  3737. mlines.0=mi-1
  3738. CALL DELAY(28)
  3739. mlines.24=STRIP(mlines.24 markdir'/'markmsg)
  3740. IF OPEN(f,bbspath'Users/'markname,'W')=0 THEN RETURN
  3741. DO mi=1 TO mlines.0
  3742.   CALL WRITELN(f,mlines.mi)
  3743. END
  3744. CALL CLOSE(f)
  3745. RETURN
  3746.  
  3747.  
  3748. shell:
  3749. SAY CR
  3750. olddir=PRAGMA('D')
  3751. DO WHILE(UPPER(opt)~='EXIT')
  3752.   SAY bak2||TIME('C')||def PRAGMA('D')||CR
  3753.   OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
  3754.   PARSE PULL opt' 'arg
  3755.   CALL checkdcd()
  3756.   IF(UPPER(opt)='CD') THEN CALL setdir(arg)
  3757.   ELSE IF exists(opt)~=0 THEN
  3758.     DO
  3759.       IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt)
  3760.     END
  3761.   ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
  3762.     ADDRESS COMMAND opt '<* >*' arg
  3763. END
  3764. CALL PRAGMA('D',olddir)
  3765. RETURN
  3766.  
  3767.  
  3768. yell:
  3769. chatrequest=1
  3770. IF excuses.1='' THEN
  3771.   DO
  3772.     IF readopen(bbspath'Lists/Excuses') THEN
  3773.       DO
  3774.         DO i=1
  3775.           line=READLN(f)
  3776.           IF EOF(f) THEN BREAK
  3777.           excuses.i=line
  3778.         END
  3779.         excuses.0=i-1
  3780.         CALL CLOSE(f)
  3781.       END
  3782.   END
  3783. j=TIME('S')//excuses.0+1
  3784. SAY CR
  3785. SAY 'Sorry, your SysOp,' sysop','CR
  3786. IF excuses.j~='' THEN SAY excuses.j||CR
  3787. ELSE SAY 'is not available, please leave a ['pen3'C'def']omment.'CR
  3788. SAY CR
  3789. IF bbsprefs.13 THEN RETURN
  3790. SAY 'I''m yelling anyway...'CR
  3791. SAY 'If nobody answers, please try again later or leave a ['pen3'C'def']omment'CR
  3792. CALL sound('YELL')
  3793. ADDRESS AREXX bbsSpeak.rexx 'CHAT' name bbspath saypath
  3794. RETURN
  3795.  
  3796.  
  3797. /* online change to member. Sysop triggered by BumpMember.baud */
  3798. /* user triggered by Call Back Verification CBV: */
  3799. validate:
  3800. ARG varg .
  3801. IF readopen(bbspath'BBS_TEXT/'varg) THEN
  3802.   DO
  3803.     SAY CR
  3804.     SAY 'You are being validated.  Please wait...'CR
  3805.     SAY CR
  3806.     DO lvi=1 TO 22
  3807.       line=READLN(f)
  3808.       IF lvi=11 THEN data.11=line
  3809.       IF lvi=17 THEN data.17=WORD(line,1) WORD(data.17,2) WORD(data.17,3)
  3810.       IF lvi=20 THEN data.20=line
  3811.       IF lvi=21 THEN data.21=line
  3812.     END
  3813.     data.22=line
  3814.     CALL CLOSE(f)
  3815.     CALL SetData()
  3816.     CALL sortlibraries()
  3817.     IF bbsprefs.25=1 THEN
  3818.       DO
  3819.         data.22=''
  3820.         data.23=''
  3821.         SAY CR
  3822.         SAY 'Setting message counters to last 10 messages in each conference...'CR
  3823.         DO i=1 TO level
  3824.           num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
  3825.           IF num<0 | msg.i.0<10 THEN num=0
  3826.           lastread.i=num
  3827.           data.22=data.22 num
  3828.           data.23=data.23 0
  3829.         END
  3830.         SAY 'Setting file counter to last file uploaded...'CR
  3831.         lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
  3832.         newfilesdate=DATE('S') TIME()
  3833.       END
  3834.     SAY CR
  3835.     CALL logonstats()
  3836.     CALL saveData(0)
  3837.     IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
  3838.       DO
  3839.         CALL MAKEDIR(bbspath'EMail/'name)
  3840.         lastwrit=countcheck(bbspath'Numbers/LastMail' 0)+1
  3841.         IF lastwrit>1 THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit)
  3842.         lynes.=''
  3843.         lynes.1=' Mail:' lastwrit
  3844.         lynes.2=' From:' sysop
  3845.         lynes.3='   To:' name
  3846.         lynes.4=' Subj: Welcome to' bbsname
  3847.         lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
  3848.         lynes.6=LEFT('',74,'=')
  3849.         CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
  3850.         CALL savelines(bbspath'EMail/'name'/'sysop'.'lastwrit)
  3851.         SAY 'You have welcoming EMail.'CR
  3852.       END
  3853.     CALL waiting()
  3854.     IF bbsprefs.22=2 & varg='DEF.CBV' THEN
  3855.       DO
  3856.         SAY CR
  3857.         SAY pen3||name def'is now a fully valadated member of'pen3 bbsname||def||CR
  3858.         SAY 'All the features of the BBS will be available on your next call.'CR
  3859.         SAY CR
  3860.         CALL waiting()
  3861.         SIGNAL LOGOUT2
  3862.       END
  3863.     SIGNAL RESTART
  3864.   END
  3865. ELSE
  3866.   DO
  3867.     SAY 'Sorry. Auto-validation is disabled.'CR
  3868.     temp=' ***' sysop'!  You need a default file in BBS_TEXT!  (' varg ') *** '
  3869.     MSG bak2||temp||def||CR
  3870.     CALL Send2log(temp)
  3871.   END
  3872. RETURN
  3873.  
  3874.  
  3875. /* online time change. Sysop triggered by BumpTime.baud */
  3876. uptime:
  3877. mins=GETCLIP('BBS_minutes')
  3878. IF DATATYPE(mins,'N') THEN
  3879.   DO
  3880.     IF (mins*60)>maxtime THEN
  3881.       SAY name', this session''s time has been increased to' mins 'minutes.'CR
  3882.     ELSE MSG '*** User has not been told that his time has decreased.'
  3883.     CALL SETCLIP('BBS_minutes')
  3884.     maxtime=mins*60
  3885.   END
  3886. RETURN
  3887.  
  3888.  
  3889. /* online level change. Sysop triggered by BumpLevels.baud */
  3890. uplevel:
  3891. levl=GETCLIP('BBS_level')
  3892. IF DATATYPE(levl,'W') THEN
  3893.   DO
  3894.     IF levl>data.20 THEN
  3895.       SAY name', your level has been changed from' data.20 'to' levl'.'CR
  3896.     ELSE MSG '*** User has not been told his level has been reduced.'
  3897.     data.20=levl
  3898.     CALL SetData()
  3899.     IF menu='NEW' THEN menu='ALL'
  3900.     CALL sortlibraries()
  3901.   END
  3902. RETURN
  3903.  
  3904.  
  3905. /* online ratio change. Sysop triggered by BumpLevels.baud */
  3906. upratio:
  3907. rats=GETCLIP('BBS_ratio')
  3908. IF DATATYPE(rats,'W') THEN
  3909.   DO
  3910.     SAY name', your upload:download ratio has been changed to 1:'rats'.'CR
  3911.     data.17=rats'  'WORD(data.17,2)'  'WORD(data.17,3)
  3912.     CALL SETCLIP('BBS_ratio')
  3913.   END
  3914. RETURN
  3915.  
  3916.  
  3917. bytes2user:
  3918. PARSE ARG indx bytes .
  3919. tfiles=WORD(data.indx,1)
  3920. tbytes=WORD(data.indx,3)
  3921. IF ~DATATYPE(tfiles,'W') THEN tfiles=0
  3922. IF ~DATATYPE(tbytes,'W') THEN tbytes=0
  3923. tbytes=tbytes+bytes
  3924. tfiles=tfiles+1
  3925. IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
  3926. ELSE data.indx='1 file' bytes 'bytes.'
  3927. data.indx=data.indx DATE()
  3928. CALL saveData(0)
  3929. RETURN
  3930.  
  3931.  
  3932. stats:
  3933. ARG indx
  3934. tfail=''
  3935. bytes=''
  3936. Status z
  3937. string=RESULT
  3938. string=COMPRESS(string,'0D'x)
  3939. IF RIGHT(BB_VERS,4)>1.59 THEN
  3940.   DO
  3941.     PARSE VAR string . 'Local Name: 'temp . 'Xfer''ed: 'bytes . 'Elapsed Time: 'min':'sec'0A'x .
  3942.     slash=LASTPOS('/',temp)
  3943.     IF slash=0 THEN slash=LASTPOS(':',temp)
  3944.     IF slash~=0 THEN temp=SUBSTR(temp,slash+1)
  3945.   END
  3946. ELSE PARSE VAR string temp' 'min':'sec . 'Bytes:'bytes .
  3947. temp=STRIP(temp)
  3948. min=STRIP(min)
  3949. sec=STRIP(sec)
  3950. bytes=STRIP(bytes)
  3951. IF temp~='' & LEFT(UPPER(STRIP(temp)),8)~=LEFT(UPPER(arg),8) THEN
  3952.   tfail='wrong file' temp
  3953. ELSE IF DATATYPE(min,'W') & DATATYPE(sec,'W') & DATATYPE(bytes,'W') THEN
  3954.   DO
  3955.     secs=(min*60)+sec
  3956.     IF indx=14 THEN CALL DELAY(100) /* wait for dos to finish upload */
  3957.     temp=STATEF(PRAGMA('D')'/'arg)
  3958.     temp=WORD(temp,2)
  3959.     IF ~DATATYPE(temp,'W') THEN temp=0
  3960.     IF indx=14 & (temp+1024)<bytes THEN tfail='ul size'
  3961.     IF indx=15 & temp>(bytes+1024) THEN tfail='dl size'
  3962.   END
  3963. ELSE tfail='not numeric: min='min 'sec='sec 'bytes='bytes
  3964. IF tfail~='' THEN
  3965.   DO
  3966.     line=plaindir'/'arg pen3'*** Transfer failed! ***'def
  3967.     SAY line||CR
  3968.     CALL send2log(line 'tfail:'tfail)
  3969.     CALL send2log('***' string)
  3970.     CALL sound('TFAIL')
  3971.     IF indx=14 & WORD(STATEF(arg),2)=0 THEN CALL DELETE(arg)
  3972.     RETURN 1
  3973.   END
  3974. ELSE IF secs>0 THEN
  3975.   Say 'Transfer Speed:' TRUNC(bytes/secs+.05,1) 'characters per second.'CR
  3976. Remote OFF
  3977. Send '^G'
  3978. Remote ON
  3979. line=left(arg,16,' ')
  3980. IF indx=14 THEN
  3981.   DO
  3982.     temp=countcheck(bbspath'Numbers/Bytes.UpLoad' 0)+bytes
  3983.     CALL countcheck(bbspath'Numbers/Bytes.UpLoad' temp)
  3984.     line=line 'uled'
  3985.   END
  3986. ELSE
  3987.   DO
  3988.     temp=countcheck(bbspath'Numbers/Bytes.DownLoad' 0)+bytes
  3989.     CALL countcheck(bbspath'Numbers/Bytes.DownLoad' temp)
  3990.     temp=countcheck(bbspath'Numbers/Files.DownLoad' 0)+1
  3991.     CALL countcheck(bbspath'Numbers/Files.DownLoad' temp)
  3992.     temp=PRAGMA('D')
  3993.     xdev=SPACE(LEFT(temp,POS(':',temp)-1),1,'_')
  3994.     tfiles=1
  3995.     IF EXISTS(arg'.xdl') THEN
  3996.       DO
  3997.         IF readopen(arg'.xdl') THEN
  3998.           DO
  3999.             xdev=READLN(f)
  4000.             tfiles=READLN(f)
  4001.             CALL CLOSE(f)
  4002.           END
  4003.       END
  4004.     temp=countcheck(bbspath'Numbers/Bytes.X.'xdev 0)+bytes
  4005.     CALL countcheck(bbspath'Numbers/Bytes.X.'xdev temp)
  4006.     temp=countcheck(bbspath'Numbers/Files.X.'xdev 0)+tfiles
  4007.     CALL countcheck(bbspath'Numbers/Files.X.'xdev temp)
  4008.     line=line 'dled'
  4009.   END
  4010. line=line protocol TIME('C') bytes 'bytes' PRAGMA('D')
  4011. CALL send2log(line)
  4012. RETURN 0
  4013.  
  4014.  
  4015. bbsspace:
  4016. ARG tabspace .
  4017. ADDRESS COMMAND 'C:info >ram:infout' bbsdevice
  4018. ok=OPEN(f,'ram:infout','R')
  4019. IF ok=0 THEN RETURN 20
  4020. line=READLN(f)
  4021. line=READLN(f)
  4022. line=READLN(f)
  4023. line=READLN(f)
  4024. CALL CLOSE(f)
  4025. IF tabspace<14 THEN SAY CR
  4026. bbsk=WORD(line,4)
  4027. IF ~DATATYPE(bbsk,'N') THEN
  4028.   DO
  4029.     line=bbsdevice 'is not an info compatible device!'
  4030.     CALL send2log(line)
  4031.     SAY pen3||line||def||CR
  4032.     bbsk=0
  4033.     RETURN
  4034.   END
  4035. bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
  4036. IF bbsk<1 THEN bbsk=0
  4037. SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
  4038. RETURN
  4039.  
  4040.  
  4041. comma:
  4042. ARG num .
  4043. dgt=LENGTH(num)
  4044. numtext=''
  4045. IF dgt>3 THEN numtext=','RIGHT(num,3)
  4046. IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
  4047. IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
  4048. IF dgt>12 THEN
  4049.   DO
  4050.     numtext=','LEFT(RIGHT(num,12),3)||numtext
  4051.     numtext=LEFT(num,dgt-12)||numtext
  4052.   END
  4053. ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
  4054. ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
  4055. ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
  4056. ELSE numtext=num
  4057. RETURN numtext
  4058.  
  4059.  
  4060. is_here:
  4061. ARG newname 
  4062. CALL WRITECH(STDOUT,'Checking filelist')
  4063. DO wi=1 TO 99
  4064.   IF wi//3=0 THEN CALL WRITECH(STDOUT,'.')
  4065.   IF dirs.wi='' THEN ITERATE wi
  4066.   IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi
  4067.   line=pen3'*** File' newname 'already exists here'
  4068.   IF wi<=level THEN line=line 'in the' dirs.wi 'library'
  4069.   line=line'.'def
  4070.   SAY CR
  4071.   SAY line||CR
  4072.   SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'CR
  4073.   CALL waiting()
  4074.   RETURN 1
  4075. END
  4076. SAY CR
  4077. CALL cleanline(1)
  4078. RETURN 0
  4079.  
  4080.  
  4081. uload:
  4082. ARG frommenu
  4083. IF frommenu THEN
  4084.   DO
  4085.     SAY CR
  4086.     SAY pen3'PLEASE!'def 'Only upload 1 (one) archive at a time. NO BATCH UPLOADING! Thanks.'CR
  4087.   END
  4088. CALL bbsspace(12)
  4089. SAY CR
  4090. IF bbsk<1 THEN
  4091.   DO
  4092.     line='Upload area is full!'
  4093.     CALL send2log(line)
  4094.     SAY pen3||line||def||CR
  4095.     RETURN 1
  4096.   END
  4097. IF arg='' THEN arg=getinput(0 0 'Filename: ')  /* no filename given */
  4098. arg=cleanstring('0:'arg)
  4099. arg=COMPRESS(arg,' :/,;|#?*')  /* be sure no illegals here */
  4100. x=LASTPOS('/',arg)
  4101. IF x=0 THEN x=LASTPOS(':',arg)
  4102. IF x>0 THEN
  4103.   DO
  4104.     IF DATATYPE(SUBSTR(arg,x+1),'W') THEN
  4105.       DO
  4106.         SAY 'Whole numbers are not allowed as filenames!'CR
  4107.         CALL waiting()
  4108.         RETURN 1
  4109.       END
  4110.   END
  4111. tempnum=LENGTH(arg)-16
  4112. DO WHILE tempnum>0 & POS('EMAILFILES',UPPER(PRAGMA('D')))=0
  4113.   temp='          'pen3||arg def'is'pen3 tempnum||def
  4114.   IF tempnum=1 THEN temp=temp 'character'
  4115.   ELSE temp=temp 'characters'
  4116.   temp=temp 'too long for a filename.'
  4117.   SAY temp||CR
  4118.   arg=getinput(0 0 'Filename: ')
  4119.   arg=cleanstring('0:'arg)
  4120.   arg=COMPRESS(arg,' :/,;|#?*()+[]"{}')
  4121.   tempnum=LENGTH(arg)-16
  4122. END
  4123. IF arg='' THEN RETURN 1
  4124. IF frommenu THEN
  4125.   DO
  4126.     IF is_here(arg) THEN RETURN 1
  4127.     IF wi=999999 THEN RETURN 1
  4128.     IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops')
  4129.     ELSE
  4130.       DO loop=1
  4131.         SAY 'Please select an appropriate library for -' pen3||arg def'-'CR
  4132.         temp=chdir()
  4133.         IF temp=0 THEN LEAVE loop
  4134.         IF temp=2 THEN RETURN 1
  4135.       END
  4136.   END
  4137. checkproto='T'
  4138. targ=arg
  4139. DO WHILE checkproto='T'
  4140.   arg=''
  4141.   SAY CR
  4142.   SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
  4143.   pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  4144.   pline=pline '['pen3'U'def']pload (qtU) > '
  4145.   checkproto=getinput(1 1 pline)
  4146.   IF checkproto='Q' THEN RETURN 1
  4147.   IF checkproto='T' THEN CALL chpro()
  4148. END
  4149. arg=targ
  4150. CALL postuser(4)
  4151. CALL sound('UPLOAD')
  4152. uploadtime=TIME('E')
  4153. SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
  4154. CALL whodat()
  4155. DownLoad arg
  4156. IF RC>0 | stats(14) THEN RETURN 2
  4157. rbytes=WORD(STATEF(arg),2)
  4158. IF rbytes<1 THEN
  4159.   DO
  4160.     CALL DELETE(arg)
  4161.     RETURN 2
  4162.   END
  4163. temp=''
  4164. DO WHILE temp~='N' & temp~='Y'
  4165.   temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
  4166. END
  4167. IF temp='N' THEN RETURN 2
  4168. IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  4169.   DO
  4170.     SAY CR
  4171.     SAY pen3'***'def arg pen3'failed archive check!'def||CR
  4172.     SAY CR
  4173.     temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
  4174.     IF temp~='Y' THEN
  4175.       DO
  4176.         CALL DELETE(arg)
  4177.         SAY CR
  4178.         RETURN 2
  4179.       END
  4180.   END
  4181. CALL bytes2user(14 rbytes)
  4182. ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
  4183. IF bbsprefs.9 & name~=sysop THEN
  4184.   DO
  4185.     newufile=bbspath'EMail/'sysop'/NEW_FILES'
  4186.     IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
  4187.     ELSE
  4188.       DO
  4189.         ok=OPEN(f,newufile,'W')
  4190.         IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***') 
  4191.       END
  4192.     IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
  4193.     CALL CLOSE(f)
  4194.   END
  4195. IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
  4196. DO ui=sysoplevel+2 TO 100
  4197.   IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0     /* no filenotes */
  4198. END
  4199. IF frommenu THEN
  4200.   DO
  4201.     uploadtime=TIME('E')-uploadtime
  4202.     IF bbsprefs.11 THEN
  4203.       DO
  4204.         maxtime=maxtime+uploadtime
  4205.         line='This session''s time has been increased by'
  4206.         line=line TRUNC(uploadtime%60+.05,1)+1 'minutes.'
  4207.         SAY CR
  4208.         SAY line||CR
  4209.         SAY 'Your ratio of bytes uploaded to bytes downloaded is 1:'ratio()||CR
  4210.       END
  4211.     CALL sound('NEW_FILE')
  4212.     DO WHILE editnote(arg)  /* INSIST on a filenote */
  4213.     END
  4214.     SAY pen3'Thank you for contributing to the' bbsname 'file libraries!'def||CR
  4215.   END
  4216. waitchar=''
  4217. RETURN 0
  4218.  
  4219.  
  4220. ratio:
  4221. upbytes=WORD(data.14,3)
  4222. IF ~DATATYPE(upbytes,'W') | upbytes<1 THEN upbytes=1
  4223. dnbytes=WORD(data.15,3)
  4224. IF ~DATATYPE(dnbytes,'W') | dnbytes<1 THEN dnbytes=1
  4225. RETURN TRUNC((dnbytes/upbytes)+.5)
  4226.  
  4227.  
  4228. findfiles:
  4229. PARSE ARG ffile .
  4230. IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile
  4231. wi=0
  4232. IF DATATYPE(ffile,'W') THEN
  4233.   DO
  4234.     IF WORDS(files.ffile)<2 THEN RETURN 0
  4235.     dirtemp=WORD(files.ffile,1)
  4236.     IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
  4237.       DO
  4238.         CALL illegal_access()
  4239.         RETURN 0
  4240.       END
  4241.     CALL setdir(libpath||dirtemp)
  4242.   END
  4243. ELSE IF EXISTS(ffile) THEN
  4244.   DO
  4245.     IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN
  4246.       DO
  4247.         IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN
  4248.           DO
  4249.             line=READLN(f)
  4250.             CALL CLOSE(f)
  4251.             ffile=WORD(line,2)
  4252.           END
  4253.       END
  4254.   END
  4255. ELSE IF EXISTS(bbspath'Information'ffile) THEN
  4256.   RETURN bbspath'Information/'ffile
  4257. ELSE
  4258.   DO
  4259.     nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1
  4260.     CALL busywait(4 1)
  4261.     DO ni=nextfilenum TO 0 BY -1
  4262.       IF ni=0 THEN
  4263.         DO
  4264.           CALL busywait(4 0)
  4265.           SAY CR
  4266.           SAY '***' files.0 'filenames scanned,'pen3 ffile def'is not on the filelist!'CR
  4267.           SAY CR
  4268.           RETURN 0
  4269.         END
  4270.       IF ni>1 THEN CALL busywait(60 ni nextfilenum)
  4271.       argtemp=WORD(files.ni,2)
  4272.       IF UPPER(argtemp)=UPPER(ffile) THEN
  4273.         DO
  4274.           dirtemp=WORD(files.ni,1)
  4275.           jj=files.ni.0
  4276.           IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
  4277.             DO
  4278.               CALL busywait(4 0)
  4279.               CALL illegal_access()
  4280.               RETURN 0
  4281.             END
  4282.           ffile=ni
  4283.           CALL setdir(libpath||dirtemp)
  4284.           LEAVE ni
  4285.         END
  4286.     END
  4287.     CALL busywait(4 0)
  4288.   END
  4289. IF wi=999999 THEN RETURN 0
  4290. ftemp=ffile
  4291. IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2)
  4292. IF ~EXISTS(ftemp) THEN
  4293.   DO
  4294.     finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp)
  4295.     IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8)
  4296.     IF ~EXISTS(ftemp) THEN
  4297.       DO
  4298.         IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'CR
  4299.         ELSE
  4300.           DO
  4301.             SAY CR
  4302.             IF WORDS(finfo)<8 THEN ftemp=plaindir'/'ftemp
  4303.             SAY '***'pen3 ftemp def'is not currently available online.'CR
  4304.             SAY ' Would you like me to notify the sysop'CR
  4305.             SAY ' that you''d like to receive this file?'CR
  4306.             IF getinput(1 1 ' (Ny) > ')='Y' THEN
  4307.               DO
  4308.                 enum=countcheck(bbspath'Numbers/LastMail' 0)+1
  4309.                 CALL countcheck(bbspath'Numbers/LastMail' enum)
  4310.                 IF writeopen(bbspath'email/'sysop'/'name'.'enum)=0 THEN RETURN
  4311.                 CALL WRITELN(f,' Mail: 'enum )
  4312.                 CALL WRITELN(f,' From: 'name)
  4313.                 CALL WRITELN(f,'   To: 'sysop)
  4314.                 CALL WRITELN(f,' Subj: File Request')
  4315.                 CALL WRITELN(f,' Date: 'DATE()'  'TIME('C'))
  4316.                 CALL WRITELN(f,'====================================================================')
  4317.                 CALL WRITELN(f,' Mr. Sysop, I would like to have this file : ')
  4318.                 CALL WRITELN(f,' 'ftemp)
  4319.                 CALL WRITELN(f,' ')
  4320.                 CALL CLOSE(f)
  4321.                 SAY CR
  4322.                 ADDRESS AREXX bbsSpeak.rexx 'FILE_REQUEST' name bbspath saypath
  4323.                 SAY 'Your file request has been sent!'CR
  4324.                 SAY 'The file should be in your Email soon.'CR
  4325.               END
  4326.             SAY CR
  4327.           END
  4328.         RETURN 0
  4329.       END
  4330.   END
  4331. RETURN ffile
  4332.  
  4333.  
  4334. illegal_access:
  4335. SAY CR
  4336. SAY '*** You are not authorized to access' ffile'!'CR
  4337. SAY '*** Send Email to' sysop 'to receive a higher level.'CR
  4338. SAY CR
  4339. IF DATATYPE(ffile,'W') THEN ffile=ffile WORD(files.ffile,2)
  4340. CALL send2log('Illegal Access Attempt!' ffile 'in' dirtemp)
  4341. RETURN
  4342.  
  4343.  
  4344. statuscheck:
  4345. PARSE ARG ffile
  4346. updownratio=WORD(data.17,1)
  4347. IF ~DATATYPE(updownratio,'N') THEN updownratio=100
  4348. updn=ratio()
  4349. dbytes=WORD(STATEF(ffile),2)
  4350. IF ~DATATYPE(dbytes,'W') THEN dbytes=1
  4351. IF ~DATATYPE(bps,'W') THEN bps=2400
  4352. needtime=dbytes%(bps%10)+10  /* plus 10 seconds for handshaking? */
  4353. SAY CR
  4354. SAY CR
  4355. CALL showtime()
  4356. SAY 'At least' TRUNC(needtime/60+.05,1) 'minutes needed to download' ffile 'at' bps 'baud.'CR
  4357. SAY 'After this transfer your upload:download ratio will be 1:'TRUNC((dbytes+dnbytes)/upbytes)||CR
  4358. IF level>(sysoplevel+1) THEN RETURN 0
  4359. IF (needtime+TIME('E'))>maxtime THEN
  4360.   DO
  4361.     SAY CR
  4362.     SAY 'Sorry, not enough time left in this session to download' dbytes 'bytes.'CR
  4363.     IF needtime>(WORD(data.11,1)*60) THEN
  4364.       SAY 'Leave email to the sysop to make other arrangements to receive this file.'CR
  4365.     SAY CR
  4366.     RETURN 1
  4367.   END
  4368. IF updownratio>0 & updn>updownratio THEN
  4369.   DO
  4370.     SAY CR
  4371.     line=pen3'       *** You must upload before you do any more downloading! ***'def
  4372.     SAY line||CR
  4373.     SAY '  Maintain a ratio of at least 1 byte uploaded for each' updownratio 'bytes downloaded.'CR
  4374.     IF bbsprefs.4 THEN RETURN 1
  4375.     SAY pen3'             - This requirement is temporarily suspended. -'def||CR
  4376.     SAY CR
  4377.   END
  4378. RETURN 0
  4379.  
  4380.  
  4381. ext_dload:
  4382. SAY CR
  4383. CALL checkdcd()
  4384. allargs=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs)
  4385. IF allargs='' | TRUNC(maxtime-TIME('E'))<30 THEN RETURN
  4386. CALL dload2()
  4387. RETURN
  4388.  
  4389.  
  4390. dload:
  4391. arg=STRIP(arg data.25)
  4392. data.25=''
  4393. curdir=PRAGMA('D')
  4394. OPTIONS PROMPT 'File numbers (and/or names): '
  4395. IF arg='' THEN PARSE PULL arg  /* no filename given */
  4396. IF arg='' THEN RETURN 0
  4397. allargs=TRANSLATE(arg,'     ',':/,;|')
  4398. tempargs=SPACE(allargs,1)
  4399. numchk=1
  4400. DO ui=1 TO WORDS(tempargs) WHILE STRIP(allargs)~=''
  4401.   arg=WORD(tempargs,ui)
  4402.   IF ~DATATYPE(arg,'W') THEN numchk=0
  4403.   wloc=WORDINDEX(allargs,FIND(allargs,arg))
  4404.   wi=0
  4405.   temp=findfiles(arg)
  4406.   IF wi=999999 THEN RETURN 0
  4407.   IF temp~=arg THEN
  4408.     DO
  4409.       allargs=DELWORD(allargs,FIND(allargs,arg),1)
  4410.       IF temp~=0 THEN allargs=INSERT(temp' ',allargs,wloc-1)
  4411.     END
  4412. END
  4413. IF numchk=0 THEN
  4414.   IF countcheck(bbspath'Numbers/LastFile' 0)>500 THEN
  4415.     DO
  4416.       SAY LEFT('',20)||CR
  4417.       SAY bak2' BBBBS Tip:'def'  Next time try using fileNUMBERS instead of fileNAMES.'CR
  4418.       SAY '              The BBS is MUCH faster at locating files by number.'CR
  4419.     END
  4420.  
  4421. dload2:
  4422. curdir=PRAGMA('D')
  4423. allargs=STRIP(allargs data.25)
  4424. data.25=''
  4425. IF allargs='' THEN RETURN 0
  4426. sleepy='T'
  4427. DO WHILE sleepy='T'
  4428.   arg=''
  4429.   SAY LEFT('',20)||CR
  4430.   temp=WORD(allargs,1)
  4431.   IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
  4432.   test=''
  4433.   IF LENGTH(temp)>40 THEN
  4434.     DO
  4435.       test=temp
  4436.       temp=''
  4437.     END
  4438.   SAY 'Filename(s)'pen3 LEFT(temp,40) def'Protocol:'pen3 protocol||def||CR
  4439.   IF test~='' THEN SAY '           'pen3 test||def||CR
  4440.   DO di=2 TO WORDS(allargs)
  4441.     temp=WORD(allargs,di)
  4442.     IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
  4443.     SAY '           'pen3 temp||def||CR
  4444.   END
  4445.   pline='['pen3'A'def']uto-Logoff-after-transfer ['pen3'D'def']ownload'
  4446.   pline=pline '['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol (aDqt)'
  4447.   sleepy=getinput(1 1 pline '> ')
  4448.   IF sleepy='Q' THEN RETURN 0
  4449.   IF sleepy='A' THEN sleepy='LOGOFF'
  4450.   IF sleepy='T' THEN CALL chpro()
  4451. END
  4452. DO WHILE allargs~=''
  4453.   errorflag=0
  4454.   extdir=''
  4455.   arg=WORD(allargs,1)
  4456.   allargs=STRIP(DELWORD(allargs,1,1))
  4457.   IF DATATYPE(arg,'W') THEN
  4458.     DO
  4459.       CALL setdir(libpath||WORD(files.arg,1))
  4460.       arg=WORD(files.arg,2)
  4461.     END
  4462.   notename=bbspath'FileNotes/'plaindir'/'arg
  4463.   finfo=''
  4464.   IF ~EXISTS(arg) THEN
  4465.     DO
  4466.       finfo=STATEF(notename)
  4467.       IF WORDS(finfo)>7 THEN
  4468.         DO
  4469.           temp=plaindir
  4470.           x=lastslash(WORD(finfo,8))
  4471.           arg=WORD(x,1)
  4472.           CALL setdir(WORD(x,2))
  4473.           plaindir=temp
  4474.         END
  4475.     END
  4476.   x=lastslash(arg)
  4477.   IF WORDS(x)>1 THEN
  4478.     DO
  4479.       arg=WORD(x,1)
  4480.       extdir=WORD(x,2)
  4481.       CALL setdir(extdir)
  4482.     END
  4483.   DO dloadloop=1
  4484.     IF statuscheck(arg) THEN
  4485.       DO
  4486.         errorflag=1
  4487.         LEAVE dloadloop
  4488.       END
  4489.     CALL postuser(5)
  4490.     CALL sound('DOWNLOAD')
  4491.     SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
  4492.     CALL checktime()
  4493.     UpLoad arg
  4494.     IF RC>0 | stats(15) THEN
  4495.       DO
  4496.         errorflag=1
  4497.         LEAVE dloadloop
  4498.       END
  4499.     CALL bytes2user(15 WORD(STATEF(arg),2))
  4500.     IF extdir='' & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 THEN
  4501.       DO dloadloop2=1 TO 1
  4502.         DO di=sysoplevel+2 TO 100
  4503.           IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop2
  4504.         END
  4505.         IF readlines(notename 1) THEN
  4506.           DO
  4507.             CALL send2log('Unable to increment download count for' plaindir'/'arg)
  4508.             LEAVE dloadloop2
  4509.           END
  4510.         dls=WORD(lynes.2,7)
  4511.         IF ~DATATYPE(dls,'W') THEN dls=0
  4512.         lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
  4513.         finfo=STATEF(notename)
  4514.         IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
  4515.         ELSE finfo=''
  4516.         CALL DELETE(notename)
  4517.         CALL savelines(notename)
  4518.         CALL DELAY(28)
  4519.         IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' notename finfo
  4520.         IF WORD(data.16,1)<WORD(lynes.1,2) THEN
  4521.           DO
  4522.             lastbrowse=WORD(lynes.1,2)
  4523.             newfilesdate=DATE('S') TIME()
  4524.           END
  4525.       END
  4526.     LEAVE dloadloop
  4527.   END
  4528. END
  4529. CALL setdir(curdir)
  4530. IF errorflag THEN SAY pen3'*** Download Failed!'def||CR
  4531. IF sleepy='LOGOFF' THEN
  4532.   DO
  4533.     SAY CR
  4534.     SAY 'Logging'pen3 'OFF' def'in 10 seconds...'CR
  4535.     SAY 'Press'pen3 RETURN def'to return to'pen3 bbsname||def||CR
  4536.     SAY CR
  4537.     Timeout 10
  4538.     WAIT '?'
  4539.     t=RC
  4540.     Timeout maxidle
  4541.     IF t~=0 THEN SIGNAL LOGOUT2
  4542.   END
  4543. RETURN errorflag
  4544.  
  4545.  
  4546. lastslash:
  4547. PARSE ARG sarg 
  4548. sdir=''
  4549. slash=LASTPOS('/',sarg)
  4550. IF slash>2 THEN sdir=LEFT(sarg,slash-1)
  4551. ELSE
  4552.   DO
  4553.     slash=LASTPOS(':',sarg)
  4554.     IF slash>0 THEN sdir=LEFT(sarg,slash)
  4555.   END
  4556. IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
  4557. RETURN sarg sdir
  4558.  
  4559.  
  4560. editnote:
  4561. IF arg='' THEN
  4562.   DO
  4563.     PARSE PULL arg .
  4564.     IF arg='' THEN RETURN 0
  4565.   END
  4566. comment=''
  4567. IF ~EXISTS(arg) THEN
  4568.   DO
  4569.     finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
  4570.     temp=''
  4571.     IF WORDS(finfo)>7 THEN comment=WORD(finfo,8)
  4572.     ELSE
  4573.       DO
  4574.         IF level<sysoplevel THEN RETURN 0
  4575.         temp=getinput(1 1 'Is this file on an another device? (Nqy)')
  4576.       END
  4577.     IF temp='Y' THEN
  4578.       DO WHILE comment=''
  4579.         OPTIONS PROMPT 'Enter linkfile using full dev:path/filename > '
  4580.         PARSE PULL comment 
  4581.         comment=STRIP(comment)
  4582.         IF comment='' THEN RETURN 0
  4583.         IF ~EXISTS(comment) THEN comment=''
  4584.       END
  4585.     ELSE IF temp='Q' THEN RETURN 0
  4586.   END
  4587. IF comment='' THEN
  4588.   DO
  4589.     arg=findfiles(arg)
  4590.     IF arg=0 THEN RETURN 0
  4591.     IF DATATYPE(arg,'W') THEN arg=WORD(files.arg,2)
  4592.   END
  4593. filedir=plaindir
  4594. CALL MAKEDIR(bbspath'FileNotes/'filedir)
  4595. IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
  4596.   DO
  4597.     SAY pen3'*** Failed to open directory!' filedir||def||CR
  4598.     RETURN 0
  4599.   END
  4600. notename=bbspath'FileNotes/'filedir'/'arg
  4601. lynes.=''
  4602. filenum=countcheck(bbspath'Numbers/LastFile' 0)
  4603. IF level>sysoplevel THEN firstedit=1
  4604. ELSE firstedit=5
  4605. IF EXISTS(notename) THEN
  4606.   DO
  4607.     IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
  4608.     CALL bbsED(firstedit notename)
  4609.     RETURN 0
  4610.   END
  4611. IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
  4612. ELSE filedata=STATEF(comment)
  4613. IF filedata='' THEN
  4614.   DO
  4615.     IF comment='' THEN line=filedir'/'arg
  4616.     ELSE line=comment
  4617.     SAY line 'does not exist!'CR
  4618.     RETURN 0
  4619.   END
  4620. bytes=WORD(filedata,2)
  4621. filenum=filenum+1
  4622. lynes.0=4
  4623. lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
  4624. lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes   Downloads: 0'
  4625. lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')'  Lib: 'filedir
  4626. lynes.4=LEFT('',74,'=')
  4627. lynes.1=lynes.1 edkeywords(arg filedir)
  4628. CALL seelines(1)
  4629. edtype=''
  4630. CALL writebuffer(scratch'/NoteFile')
  4631. IF savelines(notename) THEN RETURN 0
  4632. IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
  4633. fncom='R'
  4634. DO WHILE fncom='R'
  4635.   CALL seelines(1)
  4636.   nonstop=0
  4637.   line='['pen3'E'def']dit'
  4638.   IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
  4639.   line=line '['pen3'R'def']ead ['pen3'S'def']ave'
  4640.   IF level>sysoplevel THEN line=line '(ekrS) 'def
  4641.   ELSE line=line '(erS) 'def
  4642.   fncom=getinput(1 1 line)
  4643.   IF fncom='K' & level>sysoplevel THEN
  4644.     DO
  4645.       SAY 'Killing FileNote..'CR
  4646.       CALL DELETE(notename)
  4647.       RETURN 1
  4648.     END
  4649.   ELSE IF fncom='E' THEN
  4650.     DO
  4651.       IF bbsED(firstedit notename)>0 THEN RETURN 0
  4652.       fncom='R'
  4653.     END
  4654.   ELSE IF fncom~='R' THEN
  4655.     DO
  4656.       SAY 'Adjusting filelist...'CR
  4657.       IF filenum<1 THEN filenum=1
  4658.       IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',1)
  4659.       CALL countcheck(bbspath'Numbers/LastFile' filenum)
  4660.       files.0=files.0+1
  4661.       newcount=alpha.0+1
  4662.       alpha.0=newcount
  4663.       files.filenum=plaindir arg
  4664.       files.filenum.0=newcount
  4665.       libnum=finddirnum(plaindir)
  4666.       PARSE VAR lynes.1 . 'KeyWords:' keywords
  4667.       alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
  4668.       alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5)
  4669.       alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12)
  4670.       alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32))
  4671.       IF EXISTS(bbspath'Lists/Files') THEN
  4672.         x=OPEN(f,bbspath'Lists/Files','A')
  4673.       ELSE x=OPEN(f,bbspath'Lists/Files','W')
  4674.       IF x=0 THEN
  4675.         DO
  4676.           SAY '*** Failed to open' bbspath'Lists/Files'CR
  4677.           RETURN 0
  4678.         END
  4679.       CALL WRITELN(f,filenum files.filenum)
  4680.       CALL CLOSE(f)
  4681.       IF EXISTS(bbspath'Lists/Files.ALPHA') THEN
  4682.         x=OPEN(f,bbspath'Lists/Files.ALPHA','A')
  4683.       ELSE x=OPEN(f,bbspath'Lists/Files.ALPHA','W')
  4684.       IF x=0 THEN
  4685.         DO
  4686.           SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'CR
  4687.           RETURN 0
  4688.         END
  4689.       CALL WRITELN(f,alpha.newcount)
  4690.       CALL CLOSE(f)
  4691.       sortalphaflag=1
  4692.       savefileflag=1
  4693.       CALL cleanline(1)
  4694.     END
  4695. END
  4696. RETURN 0
  4697.  
  4698.  
  4699. edkeywords:
  4700. PARSE ARG kwarg
  4701. templine=''
  4702. DO WHILE LENGTH(templine)<3
  4703.   SAY CR
  4704.   SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR
  4705.   SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR
  4706.   SAY '    Note that only the first 32 characters will be used.'CR
  4707.   SAY LEFT('',43)'|'LEFT('',31,'=')'|'CR
  4708.   templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
  4709.   templine=cleanstring('0:'templine)
  4710.   templine=STRIP(LEFT(templine,32))
  4711. END
  4712. SAY CR
  4713. RETURN templine
  4714.  
  4715.  
  4716. loadfiles:
  4717. SAY def||CR
  4718. SAY 'Loading filelist...'CR
  4719. files.=''
  4720. files.0=0
  4721. IF readopen(bbspath'Lists/Files') THEN
  4722.   DO
  4723.     DO i=1
  4724.       line=READLN(f)
  4725.       IF EOF(f) THEN BREAK
  4726.       num=WORD(line,1)
  4727.       IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3)
  4728.     END
  4729.     files.0=i-1
  4730.     CALL CLOSE(f)
  4731.   END
  4732. RETURN
  4733.  
  4734.  
  4735. savefilelist:
  4736. IF level=99 THEN
  4737.   IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN
  4738.  
  4739. savefilelist2:
  4740. SIGNAL OFF BREAK_E
  4741. IF ckmaint('FILES') THEN RETURN
  4742. CALL savealphalist()
  4743. SAY 'Saving filelist...'CR
  4744. CALL SETCLIP('BBS_maint',1)
  4745. xarg=bbspath'Lists/Files'
  4746. CALL DELETE(xarg)
  4747. filenum=countcheck(bbspath'Numbers/LastFile' 0)
  4748. IF filenum<1 | writeopen(xarg)=0 THEN RETURN
  4749. DO i=1 TO filenum
  4750.   IF files.i='' THEN ITERATE i
  4751.   CALL WRITELN(f,i files.i)
  4752. END
  4753. CALL CLOSE(f)
  4754. CALL SETCLIP('BBS_maint')
  4755. savefileflag=0
  4756. IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
  4757. RETURN
  4758.  
  4759.  
  4760. loadalpha:
  4761. SAY def||CR
  4762. SAY 'Loading the alphabetical filelist...'CR
  4763. IF readopen(bbspath'Lists/Files.ALPHA') THEN
  4764.   DO
  4765.     alpha.=''
  4766.     alpha.0=0
  4767.     DO i=1
  4768.       line=READLN(f)
  4769.       IF EOF(f) THEN LEAVE i
  4770.       fnum=WORD(line,3)
  4771.       IF DATATYPE(fnum,'W') THEN
  4772.         DO
  4773.           alpha.i=line
  4774.           files.fnum.0=i
  4775.         END
  4776.       ELSE i=i-1
  4777.     END
  4778.     CALL CLOSE(f)
  4779.     tf=bbspath'Lists/Files.ALPHA.add'
  4780.     IF EXISTS(tf) & ~SHOW('P','BBSFILE') THEN
  4781.       IF readopen(tf) THEN
  4782.         DO
  4783.           DO i=i
  4784.             line=READLN(f)
  4785.             IF EOF(f) THEN LEAVE i
  4786.             fnum=WORD(line,3)
  4787.             IF DATATYPE(fnum,'W') THEN
  4788.               DO
  4789.                 alpha.i=line
  4790.                 files.fnum.0=i
  4791.               END
  4792.             ELSE i=i-1
  4793.           END
  4794.           CALL CLOSE(f)
  4795.           CALL DELETE(tf)
  4796.         END
  4797.     alpha.0=i-1
  4798.     IF alpha.0<files.0 THEN buildalpha=1
  4799.   END
  4800. ELSE SAY pen3'*** Lists/Files.ALPHA failed to open for reading!'def||CR
  4801. SAY CR
  4802. RETURN
  4803.  
  4804.  
  4805. ckmaint:
  4806. ARG ckfile .
  4807. IF GETCLIP('BBS_maint')~='' THEN
  4808.   DO
  4809.     DO i=0 TO 23 WHILE GETCLIP('BBS_maint')~=''
  4810.       IF i//2=0 THEN SAY 'Waiting' (24-i)*5 'more seconds for' ckfile 'list update to finish...'CR
  4811.       CALL DELAY(250)
  4812.     END
  4813.     IF i>23 THEN
  4814.       DO
  4815.         line='*** unable to update' ckfile 'list.'
  4816.         CALL send2log(line DATE() TIME('C'))
  4817.         SAY line||CR
  4818.         RETURN 1
  4819.       END
  4820.   END
  4821. RETURN 0
  4822.  
  4823.  
  4824. savealphalist:
  4825. SIGNAL OFF BREAK_E
  4826. IF ckmaint('ALPHA') THEN RETURN
  4827. CALL SETCLIP('BBS_maint',1)
  4828. IF GETCLIP('BBS_localfiles')~='' THEN
  4829.   DO
  4830.     CALL SETCLIP('BBS_localfiles')
  4831.     CALL loadfiles()
  4832.     CALL loadalpha()
  4833.   END
  4834. aarg=bbspath'Lists/Files.ALPHA'
  4835. CALL DELETE(aarg)
  4836. IF sortalphaflag=1 THEN
  4837.   DO
  4838.     SAY 'Alphabetizing' alpha.0 'files...'CR
  4839.     IF alpha.0>0 THEN CALL QSORT(1,alpha.0,alpha)
  4840.     DO i=1 TO alpha.0
  4841.       fnum=WORD(alpha.i,3)
  4842.       files.fnum.0=i
  4843.     END
  4844.   END
  4845. sortalphaflag=0
  4846. IF writeopen(aarg)=0 THEN
  4847.   DO
  4848.     SAY '*** Error opening' aarg '!'CR
  4849.     CALL SETCLIP('BBS_maint')
  4850.     RETURN
  4851.   END
  4852. SAY 'Saving alphabetical filelist...'CR
  4853. DO i=1 TO alpha.0
  4854.   ii=WORD(alpha.i,3)
  4855.   IF files.ii='' THEN alpha.i='0 0' ii '100'
  4856.   IF LEFT(alpha.i,4)~='0 0 ' THEN CALL WRITELN(f,alpha.i)
  4857. END
  4858. CALL CLOSE(f)
  4859. CALL SETCLIP('BBS_maint')
  4860. CALL bbsALPHA.rexx(SUBSTR(extension,2) arccom)
  4861. RETURN
  4862.  
  4863.  
  4864. viewuser:
  4865. SAY CR
  4866. SAY bak2' 'name' 'def||CR
  4867. DO i=1 TO 18
  4868.   stuff=data.i
  4869.   IF i=13 | i=14 THEN stuff=DATE(,data.i,'S')
  4870.   SAY RIGHT(i,2)||pen3 text.i||def':' stuff||CR
  4871. END
  4872. CALL waiting()
  4873. RETURN
  4874.  
  4875.  
  4876. edituser:
  4877. IF level>0 THEN
  4878.   IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN
  4879.     DO
  4880.       SAY CR
  4881.       SAY pen3'     - Message Conference Access -'def||CR
  4882.       SAY '[O]ff turns all message conferences OFF.'CR
  4883.       SAY 'Set the last message read by you in ALL message conferences'CR
  4884.       temp=getinput(1 1 ' ['pen3'F'def']irst  ['pen3'L'def']ast  ['pen3'O'def']ff  ['pen3'Q'def']uit  (floQ) > ')
  4885.       IF temp~='F' & temp~='O' & temp~='L' THEN RETURN
  4886.       SAY 'Resetting...'lineup||CR
  4887.       data.22=''
  4888.       DO i=1 TO level
  4889.         IF temp='F' THEN num=0
  4890.         ELSE IF temp='O' THEN num=-1
  4891.         ELSE num=countcheck(bbspath'Numbers/LastMessage'i 0)
  4892.         data.22=data.22 num
  4893.       END
  4894.       CALL SetData()
  4895.       CALL sortconferences()
  4896.       CALL savedata(1)
  4897.       RETURN
  4898.     END
  4899. new=0
  4900. change=0
  4901. edata.=''
  4902. edname=name
  4903. DO i=0 TO data.0
  4904.   edata.i=data.i
  4905. END
  4906. num=1
  4907. DO WHILE num~='' | edname~=name
  4908.   IF num='' | LEFT(num,1)='Q' THEN
  4909.     DO
  4910.       IF change THEN
  4911.         DO
  4912.           CALL SetData()
  4913.           CALL saveData(1)
  4914.           change=0
  4915.         END
  4916.       IF new THEN
  4917.         DO
  4918.           data.=''
  4919.           DO i=0 TO edata.0
  4920.             data.i=edata.i
  4921.           END
  4922.           name=edname
  4923.           new=0
  4924.         END
  4925.       CALL SetData()
  4926.     END
  4927.   maxnum=10
  4928.   IF edata.20>sysoplevel THEN maxnum=20
  4929.   IF edata.20=99 THEN maxnum=27
  4930.   SAY bak2' 'name' 'def||CR
  4931.   maxlines=21
  4932.   IF maxnum=10 THEN maxlines=20
  4933.   DO i=1 TO maxlines
  4934.     IF i=5 & name~=edname & edata.20<99 THEN ITERATE
  4935.     SAY RIGHT(i,2)||pen3 text.i||def':' data.i||CR
  4936.   END
  4937.   IF edata.20>sysoplevel THEN
  4938.     DO
  4939.       line=LEFT(' ',50)
  4940.       IF name=edname THEN line=line'NEW = Change User.'
  4941.       line=pen3||line||def||lineup
  4942.       SAY line||CR
  4943.     END
  4944.   num=getinput(1 0 'Select Line Number To Edit: ')
  4945.   IF num='NEW' & edata.20>sysoplevel & edname=name THEN    /* select a new user */
  4946.     DO
  4947.       new=1
  4948.       IF change THEN
  4949.         DO
  4950.           CALL SetData()
  4951.           CALL saveData(1)
  4952.         END
  4953.       change=0
  4954.       nufile=bbspath'Lists/NEW_USERS'
  4955.       IF EXISTS(nufile) THEN
  4956.         IF ~readlines(nufile 1) THEN CALL seelines(0)
  4957.       savename=name
  4958.       name=getinput(1 0 'New User Name: 'def)
  4959.       name=cleanstring(1':'name)
  4960.       IF loadData()=0 THEN name=savename
  4961.       IF data.20>=edata.20 THEN
  4962.         DO
  4963.           SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.'
  4964.           name=savename
  4965.           CALL loadData()
  4966.         END
  4967.     END
  4968.   ELSE IF DATATYPE(num,'W') & num>0 THEN
  4969.     DO
  4970.       IF num>maxnum THEN
  4971.         DO
  4972.           SAY CR
  4973.           SAY pen3'You are not authorized to change that information!'def||CR
  4974.           SAY CR
  4975.         END
  4976.       ELSE
  4977.         DO dummy=1 TO 1
  4978.           IF num=8 THEN
  4979.             DO
  4980.               SAY CR
  4981.               SAY 'Use spaces to separate options.'CR
  4982.               SAY 'If the option word is in line 8, it is ON.'CR
  4983.               SAY 'Valid Options:'CR
  4984.               SAY '        CLEAR  clears screen between pages.'CR
  4985.               SAY '        COLOR  turns ANSI color codes ON.'CR
  4986.               SAY '        MENU   combines all main commands into 1 menu.'CR
  4987.               SAY '        MENUS  splits main commands into 3 menus.'CR
  4988.               SAY '        PHONE  makes your phone number public.'CR
  4989.               SAY '        QUICK  activates offline options. See bbsQUICK.DOC'CR
  4990.               SAY '        STREET makes your street address public.'CR
  4991.               SAY '        TERSE  skips some of the logon procedures.'CR
  4992.               SAY CR
  4993.             END
  4994.           line=RIGHT(num,2)||pen3 text.num||def': '
  4995.           SAY line||data.num||CR
  4996.           temp=getinput(0 0 line)
  4997.           IF temp='' THEN
  4998.             DO
  4999.               IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy
  5000.               IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy
  5001.             END
  5002.           IF num=5 | num=8 THEN temp=UPPER(temp)
  5003.           IF num=20 & DATATYPE(temp,'W') & temp>=edata.20 THEN
  5004.             temp=data.20
  5005.           IF edata.20>sysoplevel & name~=edname THEN line2=name' '
  5006.           ELSE line2=''
  5007.           IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy
  5008.           line=text.num':' data.num pen6'CHANGED TO'def temp
  5009.           CALL send2log(line2||line)
  5010.           data.num=temp
  5011.           SAY line||CR
  5012.           SAY CR
  5013.           change=1
  5014.         END
  5015.     END
  5016. END
  5017. IF change THEN
  5018.   DO
  5019.     CALL SetData()
  5020.     CALL saveData(1)
  5021.   END
  5022. RETURN
  5023.  
  5024.  
  5025. getnumber:
  5026. PARSE ARG tprompt
  5027. tnum=getinput(1 0 '  'tprompt' > ')
  5028. mask=COMPRESS(XRANGE(),'0123456789')
  5029. tnum=COMPRESS(tnum,mask)
  5030. IF ~DATATYPE(tnum,'W') THEN tnum=0
  5031. tnum=tnum%1
  5032. IF tnum>0 & tnum<10 THEN tnum='0'tnum
  5033. RETURN tnum
  5034.  
  5035.  
  5036. getbirth:
  5037. data.12=WORD(data.12,1)'  'WORD(data.12,2)'  Birthday:'
  5038. SAY pen3'Please enter your birthday.'def||CR
  5039. month=getnumber('Enter the MONTH you were born: (1-12)')
  5040. day=getnumber('Enter the DAY   you were born: (1-31)')
  5041. year=getnumber('Enter the YEAR  you were born:       ')
  5042. IF year<100 THEN year=year+1900
  5043. born=year||month||day
  5044. IF born<18750101 | born>(DATE('S')-50000) THEN   /* must be older than 4 */
  5045.   DO
  5046.     born=''
  5047.     IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN
  5048.       CALL getbirth()
  5049.   END
  5050. data.12=WORD(data.12,1)'  'WORD(data.12,2)'  'WORD(data.12,3)' 'WORD(born,1)
  5051. RETURN
  5052.  
  5053.  
  5054. getname:
  5055. nonstop=0
  5056. CALL showuserlist()
  5057. SAY CR
  5058. pline='Please enter your full Email name : '
  5059. name=getinput(1 0 pline)
  5060. name=cleanstring(1':'name)
  5061. IF name='' THEN
  5062.   DO
  5063.     name=getinput(1 0 pline)
  5064.     name=cleanstring(1':'name)
  5065.     IF name='' THEN
  5066.       DO
  5067.         SAY 'No name, no entry.  Bye!'CR
  5068.         SIGNAL DONE
  5069.       END
  5070.   END
  5071. IF FIND(userlist,name)>0 | FIND(exclusion,name)>0 THEN
  5072.   DO
  5073.     SAY 'Sorry! That name is taken. Please try again.'CR
  5074.     RETURN 1
  5075.   END
  5076. IF LENGTH(name)=1 THEN
  5077.   DO
  5078.     SAY 'One letter names are not allowed,' name', please try again.'CR
  5079.     RETURN 1
  5080.   END
  5081. IF getinput(1 1 'Your name on' bbsname 'will be ' name ', is that correct? (nY) > ')='N' THEN
  5082.   RETURN 1
  5083. RETURN 0
  5084.  
  5085.  
  5086. /** see if name is in data */
  5087.  
  5088. checkUser:
  5089. tries=0
  5090. IF name='NEW' THEN
  5091.   DO
  5092.     name=''
  5093.     DO WHILE getname()
  5094.     END
  5095.     CALL postuser(7)
  5096.   END
  5097. IF FIND(userlist,name)=0 THEN
  5098.   DO
  5099.     IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
  5100.       DO
  5101.         nonstop=0
  5102.         CALL readlines(bbspath'BBS_TEXT/NEW' 1)
  5103.         CALL seelines(0)
  5104.         CALL waiting()
  5105.       END
  5106.     SAY CR
  5107.     IF getinput(1 1 'Do you want to register? (nY) > ')='N' THEN
  5108.       DO
  5109.         SAY 'Thanks anyway, bye!'CR
  5110.         line=name 'did not want to register.'
  5111.         SIGNAL OUT2
  5112.       END
  5113.     defile=bbspath'BBS_TEXT/DEF.NEW_USER'
  5114.     CALL loadcourtesy()
  5115.     wordnum=FIND(courtesy,name)
  5116.     IF wordnum>0 THEN
  5117.       DO
  5118.         SAY name', is on the Courtesy List. You will be granted immediate access.'CR
  5119.         courtesy=STRIP(DELWORD(courtesy,wordnum,1))
  5120.         IF writeopen(bbspath'Lists/Courtesy') THEN
  5121.           DO
  5122.             DO i=1 TO WORDS(courtesy)
  5123.               CALL WRITELN(f,WORD(courtesy,i))
  5124.             END
  5125.             CALL CLOSE(f)
  5126.           END
  5127.         defile=bbspath'BBS_TEXT/DEF.COURTESY'
  5128.       END
  5129.     ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'CR
  5130.     IF readlines(defile 1) THEN SIGNAL DONE
  5131.     CALL sound('NEW_USER')
  5132.     data.=''
  5133.     data.0=27
  5134.     DO i=6 TO 22
  5135.       data.i=lynes.i
  5136.     END
  5137.     data.12=DATE('S')'  'TIME('C')
  5138.     data.13=data.12
  5139.     lastondate=DATE('I')-1
  5140.     lastontime=TIME('C')
  5141.     x=FIND(UPPER(data.8),'COLOR')
  5142.     test=getinput(1 1 'Do you see colors ('pen3'ANSI' pen2'C'pen3'O'pen5'L'pen6'O'pen7'R' pen3'codes'def') on this line? (nY) > ')
  5143.     IF test='N' THEN
  5144.       DO
  5145.         IF x>0 THEN data.8=DELWORD(data.8,x,1)
  5146.         CALL colors(0)
  5147.       END
  5148.     ELSE IF x=0 THEN
  5149.       DO
  5150.         data.8=data.8 'COLOR'
  5151.         CALL colors(1)
  5152.       END
  5153.     DO i=60 TO 2 BY -1
  5154.       SAY RIGHT('- 'i' -',14)||CR
  5155.     END
  5156.     data.7=getinput(1 0 'What number is now at the top of your screen? > ')
  5157.     IF data.7<17 | data.7>75 THEN data.7=20
  5158.     SAY 'Please enter the password you would like to use here.'CR
  5159.     data.5=getinput(1 0 'Enter Password: ')
  5160.     DO WHILE getinput(1 1 'Your password on' bbsname 'will be :' data.5 ', is that correct? (nY) > ')='N'
  5161.       data.5=getinput(1 0 'Enter Password: ')
  5162.     END
  5163.     IF data.5='' THEN
  5164.       DO
  5165.         line=name 'refused to enter a password.'
  5166.         SIGNAL DONE
  5167.       END
  5168.     data.1=''
  5169.     DO WHILE data.1=''
  5170.       data.1=getinput(0 0 'Full (real) Name: ')
  5171.       IF data.1='' THEN SAY 'You MUST leave your real name!'CR
  5172.     END
  5173.     data.2=getinput(0 0 'Street: ')
  5174.     data.3=getinput(0 0 'City, State Zip: ')
  5175.     data.4=''
  5176.     DO WHILE data.4=''
  5177.       data.4=getinput(0 0 'Voice Phone (including areacode): ')
  5178.       IF data.4='' THEN
  5179.         SAY sysop 'MUST be able to reach you by phone to validate you!'CR
  5180.     END
  5181.     CALL getbirth()
  5182.     IF bbsprefs.8 THEN
  5183.       DO
  5184.         newufile=bbspath'Lists/NEW_USERS'
  5185.         IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
  5186.         ELSE
  5187.           DO
  5188.             ok=OPEN(f,newufile,'W')
  5189.             IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***')
  5190.           END
  5191.         IF ok~=0 THEN
  5192.           DO
  5193.             temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
  5194.             temp=temp LEFT(name,24)'=' data.1'  'data.4
  5195.             CALL WRITELN(f,temp) 
  5196.           END
  5197.         CALL CLOSE(f)
  5198.       END
  5199.     data.9=getinput(0 0 'Computer: ')
  5200.     data.10=getinput(0 0 'Interests: ')
  5201.     test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def)
  5202.     IF test='Y' THEN data.8=data.8 'STREET'
  5203.     test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def)
  5204.     IF test='Y' THEN data.8=data.8 'PHONE'
  5205.     IF bbsprefs.7>0 THEN
  5206.       DO
  5207.         data.20=bbsprefs.7
  5208.         CALL do_eleven(60 bbsprefs.16 bbsprefs.16-1)
  5209.       END
  5210.     SAY CR
  5211.     CALL SetData()
  5212.     IF data.20=0 THEN
  5213.       SAY 'Thank you, the sysop will give you higher access soon.'CR
  5214.     ELSE IF bbsprefs.25=1 THEN
  5215.       DO
  5216.         data.22=''
  5217.         data.23=''
  5218.         SAY CR
  5219.         SAY 'Setting message counters to last 10 messages in each conference...'CR
  5220.         DO i=1 TO level
  5221.           num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
  5222.           IF num<0 | msg.i.0<10 THEN num=0
  5223.           lastread.i=num
  5224.           data.22=data.22 num
  5225.           data.23=data.23 0
  5226.         END
  5227.         SAY 'Setting file counter to last file uploaded...'CR
  5228.         lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
  5229.         newfilesdate=DATE('S') TIME()
  5230.       END
  5231.     SAY CR
  5232.     SAY 'Please feel free to leave additional info by using [C]omment.'CR
  5233.     SAY CR
  5234.     CALL saveData(1)
  5235.     SAY 'Adding' name 'to the user list...'CR
  5236.     newpassword=data.5
  5237.     sortuserflag=1
  5238.     temp=countcheck(bbspath'Numbers/Users' 0)+1
  5239.     CALL countcheck(bbspath'Numbers/Users' temp)
  5240.     CALL DELETE(bbspath'Lists/USERS')
  5241.   END
  5242. ELSE
  5243.   DO
  5244.     IF loadData()=0 THEN SIGNAL DONE
  5245.     PARSE VAR data.11 amins . . . ttimes . . . atimes .
  5246.     lastondate=DATE('I',WORD(data.13,1),'S')
  5247.     lastontime=WORD(data.13,2)
  5248.     IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=ttimes
  5249.     IF level=99 THEN amins=120
  5250.     data.13=DATE('S')'  'TIME()
  5251.     CALL do_eleven(amins ttimes atimes-1)
  5252.     IF atimes<1 & DATE('I')=lastondate THEN
  5253.       DO
  5254.         SAY CR
  5255.         SAY CR
  5256.         line= 'Too many calls today.   Call tomorrow.'
  5257.         SAY line||CR
  5258.         SAY CR
  5259.         SAY CR
  5260.         CALL send2log(line)
  5261.         city=docity(data.3)
  5262.         SIGNAL LOGOUT
  5263.       END
  5264.     data.13=DATE('S')'  'TIME('C')
  5265.     SAY CR
  5266.     SAY pen3'Password will'def 'NOT' pen3'be echoed.'def||CR
  5267.     SAY CR
  5268.     passprompt='Enter Password: '
  5269.     DO tries=1 TO 3
  5270.       Send passprompt
  5271.       Remote OFF
  5272.       OPTIONS PROMPT ''
  5273.       newpassword=getinput(1 0 '')
  5274.       Remote ON
  5275.       IF(password=newpassword) THEN
  5276.         DO
  5277.           SAY ''CR
  5278.           LEAVE tries; /* correct password */
  5279.         END
  5280.       IF tries=3 THEN
  5281.         DO             /* 3 tries, hang up */
  5282.           SAY ''CR
  5283.           SAY 'Access terminated.'CR
  5284.           line='*** Bad password ***' newpassword '***'
  5285.           SAY line||CR
  5286.           city=line
  5287.           CALL postuser(6)
  5288.           SIGNAL OUT2
  5289.         END
  5290.       SAY ''lineup'                                 'CR
  5291.       passprompt='Incorrect.  Password: ' /* ask again */
  5292.     END
  5293.   END
  5294. SAY CR
  5295. IF bbsprefs.23=1 THEN
  5296.   DO
  5297.     SAY 'Working...'CR
  5298.     ADDRESS AREXX bbsSpeak.rexx 'LOGON' name bbspath saypath
  5299.   END
  5300. RETURN
  5301.  
  5302.  
  5303. do_eleven:
  5304. ARG am tc at .
  5305. data.11=am 'minutes per call,' tc 'calls per day,'
  5306. data.11=data.11 at 'more calls today'
  5307. RETURN
  5308.  
  5309.  
  5310. saveData:
  5311. ARG messflag .
  5312. IF data.5='' THEN RETURN
  5313. temp=GETCLIP(name'_UPDATE')
  5314. IF temp~='' THEN
  5315.   DO
  5316.     CALL SETCLIP(name'_UPDATE')
  5317.     PARSE VAR temp upfiles' 'upbytes' 'upmail' 'upmsg
  5318.     IF upfiles>0 THEN
  5319.       DO
  5320.         files=WORD(data.14,1)
  5321.         bytes=WORD(data.14,3)
  5322.         IF DATATYPE(files,'W') THEN upfiles=upfiles+files
  5323.         IF DATATYPE(bytes,'W') THEN bytes=upbytes
  5324.         data.14=upfiles 'files' bytes 'bytes.' DATE()
  5325.       END
  5326.     IF upmail>0 THEN
  5327.       DO
  5328.         mail=WORD(data.17,2)
  5329.         IF DATATYPE(mail,'W') THEN upmail=upmail+mail
  5330.         data.17=WORD(data.17,1) upmail WORD(data.17,3)
  5331.       END
  5332.     IF upmsg~='' THEN
  5333.       DO
  5334.         temp=data.23
  5335.         DO i=1 TO level
  5336.           msg=WORD(temp,i)
  5337.           IF ~DATATYPE(msg,'W') THEN msg=0
  5338.           IF FIND(upmsg,i) THEN msg=msg+1
  5339.           data.23=data.23 msg
  5340.         END
  5341.       END
  5342.   END
  5343. SAY 'Updating...             'lineup||CR
  5344. SIGNAL OFF BREAK_E
  5345. Status Trans
  5346. data.6=STRIP(RESULT)
  5347. IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
  5348. ELSE IF lastbrowse>0 THEN
  5349.   DO
  5350.     IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
  5351.     ELSE data.16=DATE('S') TIME()
  5352.     data.16=lastbrowse data.16
  5353.   END
  5354. IF messflag THEN
  5355.   DO
  5356.     userexclude.=0
  5357.     DO si=1 TO WORDS(data.22)
  5358.       IF WORD(data.22,si)=-1 THEN userexclude.si=1
  5359.     END
  5360.     data.22=''
  5361.     data.23=''
  5362.     DO si=1 TO level
  5363.       IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0
  5364.       IF userexclude.si THEN data.22=data.22 '-1'
  5365.       ELSE data.22=data.22 lastread.si
  5366.       IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0
  5367.       data.23=data.23 totwrit.si
  5368.     END
  5369.   END
  5370. IF writeopen(bbspath'USERS/'name)=0 THEN RETURN
  5371. IF data.0<27 THEN data.0=27
  5372. DO i=1 TO data.0
  5373.   CALL WRITELN(f,data.i)
  5374. END
  5375. CALL CLOSE(f)
  5376. SAY 'User' name 'has been updated.'CR
  5377. RETURN
  5378.  
  5379.  
  5380. loadData:
  5381. IF name='' THEN RETURN 0
  5382. IF ~readopen(bbspath'USERS/'name) THEN RETURN 0
  5383. data.=''
  5384. DO i=1
  5385.   line=READLN(f)
  5386.   IF EOF(f) THEN BREAK
  5387.   data.i=line
  5388. END
  5389. data.0=i-1
  5390. CALL CLOSE(f)
  5391. winnings=WORD(data.18,1)
  5392. IF ~DATATYPE(winnings,'N') THEN winnings=0
  5393.  
  5394. setData:
  5395. IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
  5396. lastbrowse=WORD(data.16,1)
  5397. IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0
  5398. level=data.20
  5399. DO i=1 TO level
  5400.   lastread.i=WORD(data.22,i)
  5401.   IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0
  5402.   totwrit.i=WORD(data.23,i)
  5403.   IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0
  5404. END
  5405. password=data.5
  5406. IF data.6='' THEN
  5407.   DO
  5408.     Status Trans
  5409.     data.6=RESULT
  5410.   END
  5411. ELSE
  5412.   DO
  5413.     IF RIGHT(UPPER(data.6),2)='-G' THEN data.6='G'
  5414.     IF RIGHT(UPPER(data.6),3)='-1K' THEN data.6='K'
  5415.     IF LEFT(UPPER(data.6),1)='A' THEN data.6='Z'
  5416.     Set UPPER(LEFT(data.6,1))
  5417.   END
  5418. IF ~DATATYPE(data.7,'W') THEN data.7=20
  5419. IF data.7<5 THEN data.7=5
  5420. linesperpage=data.7
  5421. IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1
  5422. ELSE terseflag=0
  5423. IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
  5424. ELSE colorflag=0
  5425. CALL colors(colorflag)
  5426. IF FIND(UPPER(data.8),'CLEAR')>0 THEN clr='0C'x
  5427. ELSE clr=''
  5428. menu='ALL'
  5429. IF FIND(UPPER(data.8),'MENUS')>0 THEN
  5430.   DO
  5431.     menuflag=1
  5432.     menu='MAIN'
  5433.   END
  5434. ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1
  5435. ELSE menuflag=0
  5436. IF level=0 THEN menu='NEW'
  5437. IF DATATYPE(WORD(data.11,3),'W') THEN
  5438.   DO
  5439.     PARSE VAR data.11 amins . atimes .
  5440.     CALL do_eleven(amins bbsprefs.16 atimes)
  5441.   END
  5442. data.21=UPPER(data.21)
  5443. maxtime=WORD(data.11,1)*60
  5444.  
  5445. loadFriends:
  5446. CALL MAKEDIR(bbspath'Friends')
  5447. alias.=''
  5448. alias.0=0
  5449. realname.=''
  5450. CALL CLOSE(f)
  5451. IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1
  5452. DO i=1
  5453.   line=READLN(f)
  5454.   IF EOF(f) THEN LEAVE i
  5455.   alias.i=WORD(line,1)
  5456.   realname.i=WORD(line,2)
  5457. END
  5458. alias.0=i-1
  5459. CALL CLOSE(f)
  5460. RETURN 1
  5461.  
  5462.  
  5463. switchmenuflag:
  5464. IF menuflag=1 THEN
  5465.   DO
  5466.     menuflag=0
  5467.     noff='OFF'
  5468.   END
  5469. ELSE
  5470.   DO
  5471.     menuflag=1
  5472.     noff='ON'
  5473.   END
  5474. SAY 'Menus turned' pen3||noff||def'.'CR
  5475. SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'CR
  5476. RETURN
  5477.  
  5478.  
  5479. switchcolors:
  5480. IF colorflag=1 THEN
  5481.   DO
  5482.     colorflag=0
  5483.     noff='OFF'
  5484.   END
  5485. ELSE
  5486.   DO
  5487.     colorflag=1
  5488.     noff='ON'
  5489.   END
  5490. CALL colors(colorflag)
  5491. SAY 'Color turned' pen3||noff||def'.'CR
  5492. SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'CR
  5493. RETURN
  5494.  
  5495.  
  5496. /* ANSI pen color codes */
  5497. colors:
  5498. ARG onoff
  5499. IF onoff THEN
  5500.   DO
  5501.     lineup='1B'x'M'
  5502.     def='';  /* default */
  5503.     pen0='';  pen1='';  pen2='';  pen3=''
  5504.     pen4='';  pen5='';  pen6='';  pen7=''
  5505.     bak0='';  bak1='';  bak2='';  bak3=''
  5506.     bak4='';  bak5='';  bak6='';  bak7=''
  5507.   END
  5508. ELSE
  5509.   DO
  5510.     pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
  5511.     bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
  5512.     def='';  lineup=''
  5513.   END
  5514. RETURN
  5515.  
  5516.  
  5517. chpro:
  5518. arg=UPPER(LEFT(arg,1))
  5519. IF(arg='') THEN
  5520.   DO
  5521.     SAY CR
  5522.     SAY '['pen3'W'def']- WXModem'CR
  5523.     SAY '['pen3'X'def']- XModem-CRC'CR
  5524.     SAY '['pen3'K'def']- XModem-1K'CR
  5525.     SAY '['pen3'Y'def']- YModem'CR
  5526.     SAY '['pen3'G'def']- YModem-G'CR
  5527.     SAY '['pen3'Z'def']- ZModem'CR
  5528.     SAY CR
  5529.     arg=getinput(1 0 STRIP(protocol) '> ')
  5530.  END
  5531. IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
  5532. Set arg
  5533. Status Transfer
  5534. protocol=STRIP(RESULT)
  5535. SAY protocol||CR
  5536. RETURN
  5537.  
  5538.  
  5539. sortinfofiles:
  5540. infolist=SHOWDIR(bbspath'Information')
  5541. IF infolist='' THEN
  5542.   DO
  5543.     SAY CR
  5544.     SAY pen3'No files are currently in the Information drawer.'def||CR
  5545.     SAY CR
  5546.     RETURN 1
  5547.   END
  5548. IF ~DATATYPE(sortinfo.0,'W') THEN
  5549.   DO
  5550.     info.=''
  5551.     sortinfo.=''
  5552.     info.0=WORDS(infolist)
  5553.     DO i=1 TO info.0
  5554.       info.i=WORD(infolist,i)
  5555.     END
  5556.     SAY 'Sorting..'CR
  5557.     IF info.0>0 THEN CALL QSORT(1,info.0,info)
  5558.     sortinfo.0=info.0%3
  5559.     IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
  5560.     DO i=1 TO sortinfo.0
  5561.       sortinfo.i=''
  5562.       DO j=0 TO 2
  5563.         k=i+j*sortinfo.0
  5564.         IF k<=info.0 THEN
  5565.           DO
  5566.             sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19)
  5567.             infocount=WORD(STATEF(bbspath'Information/'info.k),8)
  5568.             sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19)
  5569.           END
  5570.       END
  5571.     END
  5572.     SAY lineup'         'lineup||CR
  5573.   END
  5574. RETURN 0
  5575.  
  5576.  
  5577. information:
  5578. IF sortinfofiles() THEN RETURN
  5579. CALL sound('INFO')
  5580. SAY pen3'These text files are available for reading online...'def||CR
  5581. num=1
  5582. readcount=-1
  5583. DO infoloop=1
  5584.   IF num=0 THEN
  5585.     DO
  5586.       IF readcount~=-1 THEN
  5587.         DO
  5588.           sortinfo.0=''
  5589.           IF sortinfofiles() THEN RETURN
  5590.         END
  5591.       SAY CENTER('- Number of accesses per file -',75)||CR
  5592.     END
  5593.   SAY pen3||LEFT('-',75,'-')||def||CR
  5594.   DO i=1 TO sortinfo.0
  5595.     IF num=0 THEN SAY sortinfo.i.0||CR
  5596.     ELSE SAY sortinfo.i||CR
  5597.   END
  5598.   CALL checktime()
  5599.   IF num=0 THEN
  5600.     DO
  5601.       CALL waiting()
  5602.       num=1
  5603.       ITERATE infoloop
  5604.     END
  5605.   num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def)
  5606.   IF num=0 THEN ITERATE infoloop
  5607.   IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN
  5608.   readcount=STATEF(bbspath'Information/'info.num)
  5609.   readbytes=WORD(readcount,2)
  5610.   SAY '  'info.num 'is' readbytes 'bytes.'CR
  5611.   IF getinput(1 1 '['pen3'R'def']ead or ['pen3'D'def']ownload? (dR) > ')='D' THEN
  5612.     DO
  5613.       allargs=bbspath'Information/'info.num
  5614.       CALL dload2()
  5615.     END
  5616.   ELSE
  5617.     DO
  5618.       SAY 'Loading File...'CR
  5619.       readcount=WORD(readcount,8)
  5620.       IF ~DATATYPE(readcount,'W') THEN readcount=0
  5621.       ADDRESS COMMAND 'C:filenote' bbspath'Information/'info.num readcount+1
  5622.       CALL DELAY(28)
  5623.       CALL readlines(bbspath'Information/'info.num 1)
  5624.       CALL cleanline(0)
  5625.       SAY lineup'    'lynes.0 'lines.'CR
  5626.       SAY CR    
  5627.       CALL seelines(0)
  5628.     END
  5629.   CALL showtime()
  5630.   IF waitchar~='Q' THEN CALL waiting()
  5631.   nonstop=0
  5632. END
  5633. RETURN
  5634.  
  5635.  
  5636. newfiles:
  5637. SAY CR
  5638. test=''
  5639. test=getinput(1 1 'Show one library only? (Ny) > ')
  5640. IF test='Y' THEN
  5641.   IF chdir()>0 THEN RETURN
  5642. SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'CR
  5643. lastbrowz=WORD(data.16,1)
  5644. lastfileup=countcheck(bbspath'Numbers/LastFile' 0)
  5645.  
  5646. newfiles2:
  5647. IF lastbrowz>=lastfileup THEN
  5648.   DO
  5649.     lastbrowz=0
  5650.     SAY pen3'No new files. Listing backwards by date from last file uploaded...'def||CR
  5651.   END
  5652. ELSE newfilesflag=1
  5653. j=0
  5654. IF test='Y' THEN
  5655.   DO
  5656.     filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
  5657.     CALL busywait(4 1)
  5658.   END
  5659. DO ni=lastfileup TO lastbrowz+1 BY -1
  5660.   IF files.ni~='' THEN
  5661.     DO
  5662.       IF test='Y' THEN 
  5663.         DO
  5664.           IF ni>1 THEN CALL busywait(60 ni lastfileup-lastbrowz)
  5665.           IF j>=filecount THEN LEAVE ni
  5666.           IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN
  5667.             ITERATE ni
  5668.         END
  5669.       jj=files.ni.0
  5670.       IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN
  5671.         ITERATE ni  /* unauthorized */
  5672.       IF test='Y' THEN CALL busywait(4 0)
  5673.       j=j+1
  5674.       IF j=1 THEN CALL fileheader()
  5675.       SAY alpha.jj||CR
  5676.       IF (j+2)//(linesperpage-1)=0 THEN
  5677.         IF waiting2() THEN LEAVE ni
  5678.       IF test='Y' THEN CALL busywait(4 1)
  5679.     END
  5680. END
  5681. IF test='Y' THEN CALL busywait(4 0)
  5682. IF j//linesperpage~=0 THEN CALL waiting()
  5683. IF j=0 & newfilesflag=1 THEN
  5684.   DO
  5685.     lastbrowz=999999
  5686.     newfilesflag=0
  5687.     CALL newfiles2()
  5688.   END
  5689. IF test~='Y' THEN
  5690.   DO
  5691.     CALL newinfo()
  5692.     IF lynes.0>0 THEN CALL waiting()
  5693.   END
  5694. nonstop=0
  5695. RETURN
  5696.  
  5697.  
  5698. newinfo:
  5699. lynes.=''
  5700. lynes.0=0
  5701. dm=DATE(,WORD(data.16,2),'S')
  5702. PARSE VAR dm da' 'mo' 'yr .
  5703. yr=RIGHT(yr,2)
  5704. sincedate=da'-'mo'-'yr
  5705. startline=1
  5706. arg=bbspath'Information'
  5707. IF WORD(STATEF(arg),5)>lastondate THEN
  5708.   DO
  5709.     ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate
  5710.     IF WORD(STATEF('ram:dirlist'),2)>3 THEN
  5711.       DO
  5712.         lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
  5713.         CALL readlines('ram:dirlist' startline+1)
  5714.       END
  5715.   END
  5716. arg=bbspath'Profiles'
  5717. IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  5718.   DO
  5719.     ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate
  5720.     IF WORD(STATEF('ram:dirlist'),2)>3 THEN
  5721.       DO
  5722.         startline=lynes.0+2
  5723.         lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def
  5724.         CALL readlines('ram:dirlist' startline+1)
  5725.       END
  5726.   END
  5727. arg=bbspath'rexxDoors/Data/Polls'
  5728. IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  5729.   DO
  5730.     startline=lynes.0+2
  5731.     lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def
  5732.     lynes.0=startline
  5733.   END
  5734. IF logonflag=1 THEN nonstop=1
  5735. IF lynes.0>0 THEN CALL seelines(1)
  5736. nonstop=0
  5737. RETURN
  5738.  
  5739.  
  5740. areaselect:
  5741. SAY pen3||LEFT('-',75,'-')||def||CR
  5742. DO i=1 TO msgs.0
  5743.   SAY msgs.i||CR
  5744.   IF i//linesperpage=0 THEN CALL waiting()
  5745. END
  5746. temp=getinput(1 0 pen3'Select Message Conference: 'def)
  5747. IF ~DATATYPE(temp,'W') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1
  5748. IF msg.temp='' THEN RETURN 1
  5749. msgdir=temp
  5750. RETURN 0
  5751.  
  5752.  
  5753. chdir:
  5754. string=''
  5755. SAY pen3||LEFT('-',75,'-')||def||CR
  5756. DO i=1 TO libs.0
  5757.   SAY libs.i||CR
  5758. END
  5759. dirnum=getinput(1 0 pen3'Select Library Number: 'def)
  5760. IF clr~='' THEN Send clr
  5761. IF ~DATATYPE(dirnum,'W') THEN
  5762.   DO
  5763.     waitchar=dirnum
  5764.     RETURN 2
  5765.   END
  5766.  
  5767. chdir2:
  5768. IF dirnum<1 | dirnum>99 THEN
  5769.   DO
  5770.     waitchar=dirnum
  5771.     RETURN 1
  5772.   END
  5773. IF dirs.dirnum='' THEN
  5774.   DO
  5775.     SAY pen3'That library number is currently un-assigned.'def||CR
  5776.     RETURN 1
  5777.   END
  5778. IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
  5779.   DO
  5780.     SAY pen3'You do not have authorization for that library!'def||CR
  5781.     RETURN 1
  5782.   END
  5783. CALL MAKEDIR(libpath||dirs.dirnum)
  5784. CALL setdir(libpath||dirs.dirnum)
  5785. t=libpath||plaindir'.txt'
  5786. IF ~EXISTS(t) THEN RETURN 0
  5787. nonstop=1
  5788. SAY CR
  5789. CALL readlines(t 1)
  5790. CALL seelines(1)
  5791. SAY CR
  5792. nonstop=0
  5793. RETURN 0
  5794.  
  5795.  
  5796. since:
  5797. dm=DATE(,WORD(data.16,2),'S')
  5798. SAY CR
  5799. SAY 'New files or files moved since' dm||CR
  5800. CALL listsince()
  5801. CALL readlines('RAM:dirlist' 1)
  5802. CALL seelines(1)
  5803. nonstop=0
  5804. CALL waiting()
  5805. RETURN
  5806.  
  5807.  
  5808. listsince:
  5809. dm=DATE(,WORD(data.16,2),'S')
  5810. PARSE VAR dm da' 'mo' 'yr .
  5811. yr=RIGHT(yr,2)
  5812. sincedate=da'-'mo'-'yr
  5813. ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES SINCE' sincedate
  5814. RETURN
  5815.  
  5816.  
  5817. list:
  5818. onetime=0
  5819. IF DATATYPE(arg,'W') THEN onetime=1
  5820. ELSE arg=''
  5821. DO listloop=1
  5822.   IF DATATYPE(arg,'W') THEN
  5823.     DO
  5824.       dirnum=arg
  5825.       arg=''
  5826.       IF chdir2()>0 THEN RETURN
  5827.       CALL listsimple()
  5828.       IF waitchar='Q' | onetime THEN LEAVE listloop
  5829.     END
  5830.   ELSE IF arg='' THEN
  5831.     DO
  5832.       IF chdir()>0 THEN RETURN
  5833.       test='Y'
  5834.       CALL showalpha2()
  5835.       arg=''
  5836.       IF waitchar='Q' THEN waitchar=''
  5837.       IF waitchar~='' THEN RETURN
  5838.       ITERATE listloop
  5839.     END
  5840.   ELSE RETURN
  5841. END
  5842. RETURN
  5843.  
  5844.  
  5845. listsimple:
  5846. ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES'
  5847. IF readlines('RAM:dirlist' 1) THEN RETURN
  5848. IF lynes.0>3 THEN
  5849.   DO
  5850.     SAY pen3'Sorting...'def||lineup||CR
  5851.     linesave=lynes.1  /* these 4 lines put in to leave dir title at top */
  5852.     lynes.1='0'
  5853.     IF lynes.0>1 THEN CALL QSORT(1,lynes.0-1,lynes)
  5854.     CALL DELAY(14)
  5855.     lynes.1=linesave
  5856.   END
  5857. CALL seelines(1)
  5858. nonstop=0
  5859. CALL waiting()
  5860. RETURN
  5861.  
  5862.  
  5863. browse:
  5864. curdironly=0
  5865. brdir=PRAGMA('D')
  5866. brfilenum=1
  5867. nonstop=0
  5868. IF files.0<1 THEN RETURN
  5869. lastfilenum=countcheck(bbspath'Numbers/LastFile' 0)
  5870. IF lastfilenum<1 THEN RETURN
  5871. onearg=0
  5872. IF arg='' THEN
  5873.   DO
  5874.     lin='Browsing'
  5875.     test=getinput(1 1 'Browse one library only? (Ny) > ')
  5876.     IF test='Y' THEN
  5877.       DO
  5878.         IF chdir()>0 THEN RETURN
  5879.         curdironly=1
  5880.         lin=lin 'the' pen3||plaindir||def 'library'
  5881.         t=libpath||plaindir'.txt'
  5882.         IF level>sysoplevel THEN
  5883.           IF getinput(1 1 'Edit the'pen3 Plaindir def'library info file? (Ny) > ')='Y' THEN
  5884.             DO
  5885.               IF ~EXISTS(t) THEN
  5886.                 DO
  5887.                   IF writeopen(t)~=0 THEN
  5888.                     DO
  5889.                       CALL WRITELN(f,TRIM(CENTER('***' plaindir '***',77)))
  5890.                       CALL WRITELN(f,LEFT('',75,'='))
  5891.                       CALL CLOSE(f)
  5892.                       CALL DELAY(28)
  5893.                     END
  5894.                 END
  5895.               CALL bbsED(1 t)
  5896.               RETURN
  5897.             END
  5898.       END
  5899.     ELSE lin=lin 'all file libraries'
  5900.     lin=lin 'backwards from latest file.'
  5901.     SAY lin||CR
  5902.     SAY CR
  5903.   END
  5904. ELSE onearg=1
  5905. i=0
  5906. IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
  5907.   DO lastfileloop=1
  5908.     IF lastfilenum<1 THEN RETURN
  5909.     arg=WORD(files.lastfilenum,2)
  5910.     brfilenum=lastfilenum
  5911.     IF WORD(files.lastfilenum,2)~='' THEN LEAVE lastfileloop
  5912.     lastfilenum=lastfilenum-1
  5913.   END
  5914. ELSE IF DATATYPE(arg,'W') THEN
  5915.   DO
  5916.     brfilenum=arg
  5917.     arg=WORD(files.arg,2)
  5918.     IF arg='' THEN
  5919.       DO
  5920.         SAY 'File number' brfilenum 'does not exist in the current libraries!'CR
  5921.         RETURN
  5922.       END
  5923.   END
  5924. ELSE
  5925.   DO
  5926.     IF onearg THEN CALL busywait(4 1)
  5927.     DO ni=lastfilenum TO 1 BY -1
  5928.       IF onearg THEN CALL busywait(60 ni lastfilenum)
  5929.       IF UPPER(WORD(files.ni,2))~=UPPER(arg) THEN ITERATE ni
  5930.       brfilenum=ni
  5931.       CALL busywait(4 0)
  5932.       LEAVE ni
  5933.     END
  5934.     IF ni<1 THEN
  5935.       DO
  5936.         SAY 'Unable to find a file description for' pen3||arg||def'.'CR
  5937.         RETURN
  5938.       END
  5939.   END
  5940. IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1))
  5941. savearg=arg
  5942. IF brfilenum>lastfilenum THEN brfilenum=lastfilenum
  5943. newfilesdate=DATE('S') TIME()
  5944. DO browseloop=1
  5945.   IF curdironly THEN CALL busywait(4 1)
  5946.   DO ni=brfilenum TO 0 BY -1
  5947.     IF ni=0 THEN LEAVE browseloop
  5948.     IF files.ni='' THEN ITERATE ni
  5949.     IF onearg THEN
  5950.       DO
  5951.         CALL busywait(60 ni lastfilenum)
  5952.         IF UPPER(arg)~=UPPER(WORD(files.ni,2)) THEN ITERATE ni
  5953.         IF (ni//30)>0 THEN CALL busywait(4 1)
  5954.         LEAVE ni
  5955.       END
  5956.     testdir=UPPER(WORD(files.ni,1))
  5957.     IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN
  5958.       DO
  5959.         IF ni>lastbrowse THEN lastbrowse=ni
  5960.         IF ni>0 THEN CALL busywait(60 ni lastfilenum)
  5961.         ITERATE ni
  5962.       END
  5963.     IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
  5964.       DO
  5965.         IF ni>lastbrowse THEN lastbrowse=ni
  5966.         ITERATE ni
  5967.       END
  5968.     LEAVE ni
  5969.   END
  5970.   IF curdironly | onearg THEN CALL busywait(4 0)
  5971.   onearg=0
  5972.   IF ni=0 THEN brfilenum=lastbrowse
  5973.   ELSE brfilenum=ni
  5974.   argname=WORD(files.brfilenum,2)
  5975.   IF argname='' THEN RETURN
  5976.   CALL setdir(libpath||WORD(files.brfilenum,1))
  5977.   arg=bbspath'FileNotes/'plaindir'/'argname
  5978.   CALL readlines(arg 1)
  5979.   IF nonstop=1 THEN brostop=1
  5980.   ELSE brostop=0
  5981.   CALL seelines(1)
  5982.   IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
  5983.   CALL checktime()
  5984.   IF brostop THEN
  5985.     DO
  5986.       SAY CR
  5987.       nonstop=1
  5988.       brfilenum=brfilenum-1
  5989.     END
  5990.   ELSE
  5991.     DO
  5992.       line=''
  5993.       endtest=UPPER(RIGHT(argname,4))
  5994.       IF FIND('.ARC .ARJ .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN
  5995.         line='['pen3'C'def']ontents ['pen3'D'def']ownload'
  5996.       ELSE line='['pen3'D'def']ownload'
  5997.       IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  5998.         line=line '['pen3'E'def']dit'
  5999.       IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  6000.         line=line '['pen3'K'def']ill'
  6001.       IF level>sysoplevel THEN line=line '['pen3'L'def']ib'
  6002.       line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop'
  6003.       IF endtest='.TXT' THEN line=line '['pen3'R'def']ead'
  6004.       line=line '['pen3'Q'def']uit ['pen3'?'def'] > '
  6005.       brcom=getinput(1 0 line)
  6006.       IF DATATYPE(brcom,'W') THEN
  6007.         DO
  6008.           brfilenum=brcom+1
  6009.           IF brfilenum>lastfilenum THEN brfilenum=lastfilenum+1
  6010.           IF brfilenum<1 THEN brfilenum=1
  6011.           SAY CR
  6012.         END
  6013.       ELSE brcom=LEFT(brcom,1)
  6014.       CALL cleanline(0)
  6015.       IF brcom='Q' THEN LEAVE browseloop
  6016.       IF brcom='M' THEN
  6017.         DO
  6018.           wordnum=FIND(data.25,brfilenum)
  6019.           IF wordnum=0 THEN
  6020.             DO
  6021.               data.25=STRIP(data.25 brfilenum)
  6022.               SAY lineup||argname 'marked for next download.'CR
  6023.               SAY CR
  6024.             END
  6025.           ELSE
  6026.             DO
  6027.               data.25=STRIP(DELWORD(data.25,wordnum,1))
  6028.               SAY argname 'removed from download list.'CR
  6029.             END
  6030.         END
  6031.       IF brcom='H' | brcom='?' THEN
  6032.         DO
  6033.           SAY pen3' - HELP with the Browse Files commands -'def||CR
  6034.           SAY ' RETURN reads the next file description in line.'CR
  6035.           SAY ' 34 will display the description of file number 34, if it exists.'CR
  6036.           SAY ' C  displays the contents of an archived (arc dms lzh lha zip zoo) file.'CR
  6037.           SAY ' D  displays the download menu.'CR
  6038.           IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  6039.             DO
  6040.           SAY ' E  puts this file description into the online Editor.'CR
  6041.           SAY ' K  deletes a file you uploaded. you cannot Kill others!'CR
  6042.             END
  6043.           IF level>sysoplevel THEN
  6044.           SAY ' L  move file and description to new Library and/or rename.'CR
  6045.           SAY ' M  mark/unmark the current file for the next download'CR
  6046.           SAY ' N  displays all descriptions without pausing. CTRL-E to Exit!'CR
  6047.           SAY ' R  displays file as text. - ONLY FILES THAT END IN .TXT -'CR
  6048.           SAY ' Q  returns to the main menu(s). (Quit)'CR
  6049.           SAY CR
  6050.           CALL waiting()
  6051.           IF waitchar='Q' THEN LEAVE browseloop
  6052.         END
  6053.       ELSE IF brcom='L' & level>sysoplevel THEN
  6054.         DO
  6055.           curdir=PRAGMA('D')
  6056.           IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN
  6057.             DO
  6058.               newarg=getinput(0 0 'Rename' argname 'to ')
  6059.               IF newarg~='' THEN
  6060.                 DO
  6061.                   IF is_here(newarg) THEN ITERATE browseloop
  6062.                   IF wi=999999 THEN ITERATE browseloop
  6063.                   IF EXISTS(libpath||filedir'/'newarg) THEN
  6064.                     DO
  6065.                       SAY CR
  6066.                       SAY '***' newarg 'already exists!'CR
  6067.                       SAY CR
  6068.                       ITERATE browseloop
  6069.                     END
  6070.                   junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ')
  6071.                   IF junk='Y' THEN
  6072.                     DO
  6073.                       lynes.2=OVERLAY(newarg,lynes.2,7,25)
  6074.                       comment=WORD(STATEF(arg),8)
  6075.                       CALL DELETE(arg)
  6076.                       arg=bbspath'FileNotes/'plaindir'/'newarg
  6077.                       CALL savelines(arg)
  6078.                       IF comment='' THEN
  6079.                         DO
  6080.                           mpath=libpath||plaindir
  6081.                           IF RENAME(mpath'/'argname,mpath'/'newarg)=0 THEN
  6082.                             SAY 'Rename failed on main file!'CR
  6083.                         END
  6084.                       ELSE
  6085.                         DO
  6086.                           t=LASTPOS('/',comment)
  6087.                           IF t=0 THEN t=LASTPOS(':',comment)
  6088.                           mpath=LEFT(comment,t-1)
  6089.                           IF RENAME(comment,mpath'/'newarg)=1 THEN
  6090.                             ADDRESS COMMAND 'C:FileNote' arg mpath'/'newarg
  6091.                           ELSE SAY 'Rename failed on external file!'CR
  6092.                         END
  6093.                       files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg
  6094.                       anum=files.brfilenum.0
  6095.                       alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2)
  6096.                       CALL send2log('RENAME:' argname 'to' newarg 'in' plaindir)
  6097.                       argname=newarg
  6098.                       sortalphaflag=1
  6099.                       savefileflag=1
  6100.                     END
  6101.                 END
  6102.             END
  6103.           mvdir=getinput(0 0 'Move' argname 'to Library (name|number) ')
  6104.           IF mvdir~='' THEN
  6105.             DO
  6106.               IF DATATYPE(mvdir,'W') THEN
  6107.                 DO
  6108.                   dirnum=mvdir
  6109.                   IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN
  6110.                     DO
  6111.                       IF chdir2()=0 THEN
  6112.                         DO
  6113.                           CALL readlines(arg 1)
  6114.                           CALL movefile(brfilenum dirs.dirnum)
  6115.                         END
  6116.                     END
  6117.                 END
  6118.               ELSE
  6119.                 DO
  6120.                   mvdir=STRIP(mvdir)
  6121.                   IF UPPER(mvdir)~=UPPER(WORD(files.brfilenum,1)) THEN
  6122.                     DO
  6123.                       DO mj=1 TO level+1
  6124.                         IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj
  6125.                       END
  6126.                       IF mj<=level THEN CALL movefile(brfilenum mvdir)
  6127.                     END
  6128.                 END
  6129.             END
  6130.           IF savefileflag>0 THEN CALL savefilelist()
  6131.           CALL setdir(curdir)
  6132.         END
  6133.       ELSE IF brcom='N' THEN
  6134.         DO
  6135.           brfilenum=brfilenum-1
  6136.           nonstop=1
  6137.           SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def||CR
  6138.           SAY CR
  6139.           CALL DELAY(100)
  6140.           brcom=''
  6141.         END
  6142.       ELSE IF brcom='C' THEN
  6143.         DO
  6144.           temp=STRIP(WORD(STATEF(arg),8))
  6145.           IF temp='' THEN temp=libpath||plaindir'/'argname
  6146.           CALL Contents.rexx(temp)
  6147.           IF EXISTS('RAM:CONTENTS') THEN
  6148.             DO
  6149.               CALL cleanline(1)
  6150.               CALL readlines('RAM:CONTENTS' 1)
  6151.               CALL seelines(0)
  6152.               IF waitchar~='Q' THEN CALL waiting()
  6153.               nonstop=0
  6154.             END
  6155.           ELSE SAY pen3'Not an archived file.'def||CR
  6156.         END
  6157.       ELSE IF brcom='D' THEN
  6158.         DO
  6159.           arg2=arg
  6160.           arg=brfilenum
  6161.           CALL dload()
  6162.           arg=arg2
  6163.         END
  6164.       ELSE IF brcom='E' THEN
  6165.         DO
  6166.           IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  6167.             DO
  6168.               firstedit=5
  6169.               IF level>sysoplevel THEN firstedit=1
  6170.               CALL bbsED(firstedit arg)
  6171.             END
  6172.         END
  6173.       ELSE IF brcom='K' THEN
  6174.         DO
  6175.           IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  6176.             DO
  6177.               IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
  6178.                 DO
  6179.                   tempnum=WORD(lynes.1,2)
  6180.                   IF tempnum=lastfilenum THEN
  6181.                     DO
  6182.                       CALL DELETE(bbspath'Numbers/LastFile')
  6183.                       CALL DELAY(28)
  6184.                       lastfilenum=lastfilenum-1
  6185.                       CALL countcheck(bbspath'Numbers/LastFile' lastfilenum)
  6186.                     END
  6187.                   files.tempnum=''
  6188.                   tempnum2=files.tempnum.0
  6189.                   alpha.tempnum2='0 0' tempnum '100'
  6190.                   IF SHOW('P','BBBBS_LOCAL') THEN CALL savefilelist()
  6191.                   ELSE savefileflag=1
  6192.                   finfo=STATEF(arg)
  6193.                   IF WORDS(finfo)>7 THEN argname=WORD(finfo,8)
  6194.                   CALL DELETE(argname)
  6195.                   CALL DELETE(arg)
  6196.                   CALL send2log('Killed:' argname)
  6197.                   SAY argname pen3'has been deleted.'def||CR
  6198.                 END
  6199.             END
  6200.         END
  6201.       ELSE IF brcom='R' & endtest='.TXT' THEN
  6202.         DO
  6203.           vcount=WORD(lynes.2,7)+1
  6204.           lynes.2=STRIP(DELWORD(lynes.2,7,1)) vcount
  6205.           edtype=''
  6206.           CALL savelines(arg)
  6207.           CALL showtext(argname)
  6208.         END
  6209.       ELSE brfilenum=brfilenum-1
  6210.     END
  6211. END
  6212. CALL setdir(brdir)
  6213. waitchar=''
  6214. IF nonstop THEN CALL waiting()
  6215. nonstop=0
  6216. CALL savedata(0)
  6217. RETURN
  6218.  
  6219.  
  6220. movefile:
  6221. PARSE ARG fnum movdir .
  6222. fromdir=STRIP(WORD(files.fnum,1))
  6223. farg=STRIP(WORD(files.fnum,2))
  6224. md=libpath||movdir
  6225. mf=md'/'farg
  6226. fd=libpath||fromdir
  6227. ff=fd'/'farg
  6228. fn=bbspath'FileNotes/'fromdir'/'farg
  6229. commen=WORD(STATEF(fn),8)
  6230. IF commen~='' THEN
  6231.   DO
  6232.     ff=commen
  6233.     n=LASTPOS('/',ff)
  6234.     IF n>1 THEN
  6235.       DO
  6236.         xf=SUBSTR(ff,n+1)
  6237.         tfd=LEFT(ff,n-1)
  6238.         n=LASTPOS('/',tfd)
  6239.         IF n=0 THEN n=LASTPOS(':',tfd)
  6240.         IF n>0 THEN
  6241.           DO
  6242.             tmd=LEFT(tfd,n)||movdir
  6243.             SAY 'Rename external file'pen3 ff||def||CR
  6244.             IF getinput(1 1 '                  to'pen3 tmd'/'farg||def'? (Ny) > ')='Y' THEN
  6245.               DO
  6246.                 fd=tfd
  6247.                 md=tmd
  6248.                 mf=md'/'farg
  6249.                 commen=md'/'xf
  6250.               END
  6251.             ELSE IF getinput(1 1 '          or move to'pen3 mf||def'? (Ny) > ')='Y' THEN
  6252.               DO
  6253.                 fd=tfd
  6254.                 commen=''
  6255.               END
  6256.           END
  6257.       END
  6258.   END
  6259. CALL MAKEDIR(md)
  6260. IF RENAME(ff,mf)=0 THEN
  6261.   DO
  6262.     ADDRESS COMMAND 'C:COPY' ff mf
  6263.     IF EXISTS(mf) THEN
  6264.       IF DELETE(ff)~=1 THEN SAY pen3'Unable to delete'def ff||pen3'.'def||CR
  6265.   END
  6266. files.fnum=movdir farg
  6267. lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
  6268. lynes.3=STRIP(lynes.3) movdir
  6269. CALL MAKEDIR(bbspath'FileNotes/'movdir)
  6270. mn=bbspath'FileNotes/'movdir'/'farg
  6271. CALL savelines(mn)
  6272. ndx=files.fnum.0
  6273. dnum=finddirnum(movdir)
  6274. alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15)
  6275. IF EXISTS(mn) THEN
  6276.   DO
  6277.     CALL DELETE(fn)
  6278.     comm='C:FileNote' mn
  6279.     IF commen~='' THEN comm=comm commen
  6280.     ADDRESS COMMAND comm
  6281.   END
  6282. savefileflag=1
  6283. line='Moved:' fromdir'/'farg 'to' movdir
  6284. CALL send2log(line)
  6285. SAY line||CR
  6286. RETURN
  6287.  
  6288.  
  6289. textsearch:
  6290. PARSE ARG sfile' 'sarg
  6291. IF sarg='' THEN RETURN 0
  6292. x=OPEN(f,sfile,'R')
  6293. IF x=0 THEN RETURN 0
  6294. sarg=UPPER(sarg)
  6295. stemp=UPPER(READCH(f,65000))
  6296. CALL CLOSE(f)
  6297. retflag=0
  6298. IF POS(sarg,stemp)>0 THEN retflag=1
  6299. DROP stemp
  6300. RETURN retflag
  6301.  
  6302.  
  6303. bbsSEARCH:
  6304. smenu=menu
  6305. test=UPPER(LEFT(arg,1))
  6306. IF test='F' THEN smenu='FILE'
  6307. IF test='M' THEN smenu='MSG'
  6308. IF test='U' THEN smenu='MAIN'
  6309. IF smenu='ALL' THEN
  6310.   DO
  6311.     junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ')
  6312.     IF junk='F' THEN smenu='FILE'
  6313.     ELSE IF junk='M' THEN smenu='MSG'
  6314.     ELSE IF junk='U' THEN smenu='MAIN'
  6315.     ELSE RETURN
  6316.   END
  6317. IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2)))
  6318. ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def)
  6319. IF LENGTH(STRIP(searcharg))=0 THEN RETURN
  6320. searcharg=COMPRESS(searcharg,'*')
  6321. CALL send2log('SEARCH:' smenu 'for' searcharg)
  6322. IF smenu='NEW' | smenu='MAIN' THEN
  6323.   DO
  6324.     SAY 'Searching Userlist...'CR
  6325.     DO i=1 TO WORDS(userlist)
  6326.       IF POS(UPPER(searcharg),UPPER(WORD(userlist,i)))>0 THEN
  6327.         SAY WORD(userlist,i)||CR
  6328.     END
  6329.   END
  6330. IF smenu='MSG' THEN
  6331.   DO
  6332.     IF getinput(1 1 'Search one conference only? (Ny) > ')='Y' THEN
  6333.       DO
  6334.         IF areaselect() THEN RETURN
  6335.         SAY 'Searching' msg.msgdir 'Message Conference for'pen3 searcharg||def'...'CR
  6336.         SAY CR
  6337.         CALL searchmsgdir()
  6338.       END
  6339.     ELSE
  6340.       DO
  6341.         SAY 'Searching All Public Message Conferences for'pen3 searcharg||def'...'CR
  6342.         SAY CR
  6343.         DO i=1 TO level
  6344.           msgdir=i
  6345.           IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE i
  6346.           CALL searchmsgdir()
  6347.           i=msgdir
  6348.           IF msgcom='Q' THEN i=999999
  6349.         END
  6350.       END
  6351.   END
  6352. IF smenu='FILE' THEN
  6353.   DO
  6354.     line=pen3'Searching'
  6355.     curdironly=0
  6356.     IF getinput(1 1 'Search one library only? (Ny) > ')='Y' THEN
  6357.       DO
  6358.         IF chdir()>0 THEN RETURN
  6359.         curdironly=1
  6360.         line=line 'the'def plaindir pen3'library'
  6361.         SAY CR
  6362.       END
  6363.     ELSE
  6364.       DO
  6365.         line=line 'all file libraries'
  6366.         SAY CR
  6367.         SAY pen3'WARNING!'def 'Searching' RIGHT(files.0,5) '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'CR
  6368.       END
  6369.     test=getinput(1 1 '   ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ')
  6370.     IF test='Q' THEN RETURN
  6371.     SAY CR
  6372.     SAY line 'for'def UPPER(searcharg)||CR
  6373.     SAY pen3' - To ABORT, press CTRL-E -'def||CR
  6374.     SAY CR
  6375.     IF test~='F' THEN
  6376.       DO
  6377.         CALL fileheader()
  6378.         DO i=1 TO alpha.0
  6379.           CALL busywait(60 i alpha.0)
  6380.           ii=WORD(alpha.i,4)
  6381.           IF ii>level THEN ITERATE i
  6382.           IF curdironly=1 & ii~=dirnum THEN ITERATE i
  6383.           ii=WORD(alpha.i,3)
  6384.           IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i
  6385.           tempnum=POS(UPPER(searcharg),UPPER(alpha.i))
  6386.           IF tempnum>0 THEN
  6387.             DO
  6388.               CALL busywait(4 0)
  6389.               SAY alpha.i||CR
  6390.               IF colorflag=1 THEN
  6391.                 SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR
  6392.               CALL busywait(4 1)
  6393.             END
  6394.         END
  6395.       END
  6396.     ELSE
  6397.       DO
  6398.         cck=countcheck(bbspath'Numbers/LastFile' 0)
  6399.         nonstop=1
  6400.         DO i=1 TO cck
  6401.           iii=cck+1-i
  6402.           IF files.iii='' THEN ITERATE i
  6403.           ii=files.iii.0
  6404.           ii=WORD(alpha.ii,4)
  6405.           IF ii>level THEN ITERATE i
  6406.           IF curdironly=1 & ii~=dirnum THEN ITERATE i
  6407.           IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i
  6408.           farg=WORD(files.iii,1)'/'WORD(files.iii,2)
  6409.           SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)||CR
  6410.           IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
  6411.             DO
  6412.               savei=i
  6413.               CALL readlines(bbspath'FileNotes/'farg 1)
  6414.               nonstop=1
  6415.               CALL seelines(2)
  6416.               i=savei
  6417.               SAY CR
  6418.               SAY CR
  6419.             END
  6420.         END
  6421.       END
  6422.     CALL busywait(4 0)
  6423.   END
  6424. searcharg=''
  6425. nonstop=0
  6426. SAY CR
  6427. IF i<999999 THEN SAY lineup'All available items have been searched.'CR
  6428. SAY CR
  6429. CALL waiting()
  6430. RETURN
  6431.  
  6432.  
  6433. searchmsgdir:
  6434. msglist=SHOWDIR(msgpath||msgdir)
  6435. IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)||CR
  6436. qi=WORDS(msglist)
  6437. DO wi=1 TO qi
  6438.   CALL busywait(8 wi qi)
  6439.   messnum=WORD(msglist,wi)%1
  6440.   IF textsearch(msgpath||msgdir'/'messnum searcharg) THEN
  6441.     DO
  6442.       CALL busywait(4 0)
  6443.       savelast=lastread.msgdir
  6444.       CALL readmsg(0 messnum)
  6445.       lastread.msgdir=savelast
  6446.       IF msgcom='Q' THEN RETURN
  6447.       CALL busywait(4 1)
  6448.     END
  6449. END
  6450. CALL busywait(4 0)
  6451. RETURN
  6452.  
  6453.  
  6454. finddirnum:
  6455. ARG fdirname .
  6456. DO fdir=1 TO 99
  6457.   IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
  6458. END
  6459. RETURN 100
  6460.  
  6461.  
  6462. writebuffer:
  6463. PARSE ARG bufname .
  6464. Capture OFF
  6465. CALL DELETE(bufname)
  6466. SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
  6467. IF EXISTS(bufname) THEN
  6468.   DO
  6469.     CALL DELAY(56)
  6470.     CALL DELETE(bufname)
  6471.     CALL DELAY(56)
  6472.   END
  6473. CaptWrap 74
  6474. Send pen3
  6475. Capture bufname
  6476. Send def
  6477. TimeOut 120
  6478. DO bufloop=1
  6479.   Wait '/E,/S,RING,NO CARRIER'
  6480.   Status 'L'
  6481.   test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
  6482.   CALL checkdcd()
  6483.   IF test='/E' | test='/S' THEN LEAVE bufloop
  6484. END
  6485. Send '\b\b'pen3
  6486. Capture OFF
  6487. CALL checkdcd()
  6488. TimeOut maxidle
  6489. SAY def||CR
  6490. startnum=lynes.0+1
  6491. CALL readlines(bufname startnum)
  6492. CALL wrapbuf(startnum)
  6493. QUEUE CR
  6494. RETURN
  6495.  
  6496.  
  6497. wrapbuf:
  6498. ARG startnum .
  6499. CALL cleanline(1)
  6500. SAY pen3'Wordwrapping...'def||CR
  6501. lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
  6502. lynes.startnum=cleanstring(2':'lynes.startnum)
  6503. DO wi=startnum WHILE wi<=lynes.0
  6504.   wj=wi+1
  6505.   lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  6506.   lynes.wj=cleanstring(2':'lynes.wj)
  6507.   IF LENGTH(lynes.wi)>75 THEN
  6508.     DO
  6509.       testchar=''
  6510.       IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
  6511.       IF testchar=' ' | testchar='.' | testchar=':' THEN
  6512.         DO
  6513.           DO wjj=lynes.0 TO wi+1 BY -1
  6514.             wk=wjj+1
  6515.             lynes.wk=lynes.wjj
  6516.           END
  6517.           lynes.wj=''
  6518.           lynes.0=lynes.0+1
  6519.         END
  6520.       DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
  6521.         IF WORDS(lynes.wi)=1 THEN
  6522.           lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
  6523.         lynes.wj=WORD(lynes.wi,wl) lynes.wj
  6524.         lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
  6525.       END
  6526.     END
  6527. END
  6528. RETURN
  6529.  
  6530.  
  6531. seelines:
  6532. ARG fancy .
  6533. DO i=1 TO lynes.0
  6534.   IF fancy=0 THEN SAY lynes.i||def||CR
  6535.   ELSE
  6536.     DO
  6537.       IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
  6538.       ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
  6539.         SAY pen3||lynes.i||def||CR
  6540.       ELSE SAY lynes.i||CR
  6541.       IF fancy=2 & colorflag=1 THEN
  6542.         DO
  6543.           IF searcharg~='' THEN
  6544.             DO
  6545.               testpos=POS(UPPER(searcharg),UPPER(lynes.i))
  6546.               IF testpos>0 THEN
  6547.                 SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def||CR
  6548.             END
  6549.           IF i=1 THEN
  6550.             IF WORD(lynes.1,3)='Reply' THEN
  6551.               DO
  6552.                 testpos=WORDINDEX(lynes.1,3)
  6553.                 SAY LEFT(' ',testpos-1)||pen3||lineup||SUBSTR(lynes.1,testpos)||def||CR
  6554.               END
  6555.         END
  6556.     END
  6557.   IF i//linesperpage=0 THEN
  6558.     IF waiting2() THEN LEAVE i
  6559. END
  6560. nonstop=0
  6561. RETURN
  6562.  
  6563.  
  6564. readlines:
  6565. CALL CLOSE(f)
  6566. PARSE ARG tempname readstart .
  6567. IF ~readopen(tempname) THEN RETURN 1
  6568. IF readstart<2 THEN lynes.=''
  6569. DO ri=readstart
  6570.   line=READLN(f)
  6571.   IF EOF(f) THEN BREAK
  6572.   lynes.ri=line
  6573. END
  6574. lynes.0=ri-1
  6575. CALL CLOSE(f)
  6576. DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
  6577. END
  6578. lynes.0=ri
  6579. RETURN 0
  6580.  
  6581.  
  6582. savelines:
  6583. PARSE ARG tempname .
  6584. IF EXISTS(tempname) & edtype='MAIL' THEN
  6585.   DO
  6586.     ok=OPEN(f,tempname,'A')
  6587.     IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^'))
  6588.   END
  6589. ELSE ok=OPEN(f,tempname,'W')
  6590. IF ok=0 THEN
  6591.   DO
  6592.     line='***' tempname 'failed to open for saving!'
  6593.     CALL send2log(line)
  6594.     SAY line||CR
  6595.     RETURN 1
  6596.   END
  6597. DO wi=1 TO lynes.0
  6598.   CALL WRITELN(f,lynes.wi)
  6599. END
  6600. CALL CLOSE(f)
  6601. RETURN 0
  6602.  
  6603.  
  6604. loaduserlist:
  6605. userlist=SHOWDIR(bbspath'Users')
  6606. ulynes.=''
  6607. IF ~EXISTS(bbspath'Lists/USERS') THEN CALL sortuserlist()
  6608. ELSE IF readopen(bbspath'Lists/USERS') THEN
  6609.   DO
  6610.     SAY 'Loading Userlist...'CR
  6611.     DO lui=1
  6612.       line=READLN(f)
  6613.       IF EOF(f) THEN BREAK
  6614.       ulynes.lui=line
  6615.     END
  6616.     ulynes.0=lui-1
  6617.     CALL CLOSE(f)
  6618.   END
  6619. RETURN
  6620.  
  6621.  
  6622. saveuserlist:
  6623. SIGNAL OFF BREAK_E
  6624. IF writeopen(bbspath'Lists/USERS') THEN
  6625.   DO
  6626.     DO i=1 TO ulynes.0
  6627.       CALL WRITELN(f,ulynes.i)
  6628.     END
  6629.     CALL CLOSE(f)
  6630.   END
  6631. RETURN
  6632.  
  6633.  
  6634. sortuserlist:
  6635. SAY 'Rebuilding Userlist...'CR
  6636. sortuserflag=0
  6637. userlist=SHOWDIR(bbspath'Users')
  6638. user.=''
  6639. users=WORDS(userlist)
  6640. user.0=users
  6641. DO uli=1 TO users
  6642.   user.uli=WORD(userlist,uli)
  6643.   uscore=LASTPOS('_',user.uli)
  6644.   IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'@'LEFT(user.uli,uscore-1)
  6645. END
  6646. IF users>0 THEN CALL QSORT(1,users,user)
  6647. DO uli=1 TO users
  6648.   uscore=POS('@',user.uli)
  6649.   IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'_'LEFT(user.uli,uscore-1)
  6650. END
  6651. ulynes.=''
  6652. ulynes.0=user.0%3
  6653. IF (user.0//3)>0 THEN ulynes.0=ulynes.0+1
  6654. DO i=1 TO ulynes.0
  6655.   ulynes.i=LEFT(user.i,25)
  6656.   DO j=1 TO 2
  6657.     k=i+j*ulynes.0
  6658.     IF k<=users THEN ulynes.i=ulynes.i' 'LEFT(user.k,25)
  6659.   END
  6660. END
  6661. CALL saveuserlist()
  6662. RETURN
  6663.  
  6664.  
  6665. showuserlist:
  6666. IF data.5='' THEN line='Here are the EMail names of your fellow users.'
  6667. ELSE line='   'WORDS(userlist) 'users. Use these names to address messages.'
  6668. SAY pen3||line||def||CR
  6669. DO uli=1 TO ulynes.0
  6670.   SAY ulynes.uli||CR
  6671.   IF uli//linesperpage=0 & uli<ulynes.0 THEN
  6672.     IF waiting2()=1 THEN RETURN
  6673. END
  6674. IF data.5~='' THEN CALL waiting()
  6675. RETURN
  6676.  
  6677.  
  6678. msgcount:
  6679. ARG countdir .
  6680. lastmess=0
  6681. totmsgs=0
  6682. unred=0
  6683. IF ~EXISTS(msgpath||countdir) THEN RETURN
  6684. IF STATEF(msgpath||countdir)=msg.countdir.1 THEN totmsgs=msg.countdir.0
  6685. ELSE
  6686.   DO
  6687.     totmsgs=WORDS(SHOWDIR(msgpath||countdir))
  6688.     msg.countdir.0=totmsgs
  6689.     msg.countdir.1=STATEF(msgpath||countdir)
  6690.   END
  6691. IF countdir>level | FIND(data.21,i)>0 THEN RETURN
  6692. lastread.countdir=WORD(data.22,countdir)
  6693. IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0
  6694. lastmess=countcheck(bbspath'Numbers/LastMessage'countdir 0)
  6695. IF lastread.countdir<0 THEN RETURN
  6696. firstmess=countcheck(bbspath'Numbers/FirstMessage'countdir 0)
  6697. IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
  6698. IF lastmess>0 THEN
  6699.   IF lastread.countdir>=0 THEN
  6700.     DO
  6701.       IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1
  6702.       unred=lastmess-lastread.countdir
  6703.       IF unred>totmsgs THEN unred=totmsgs
  6704.       IF unred>0 | ~logonflag THEN
  6705.         DO
  6706.           cline=RIGHT(unred,6) 'new of'
  6707.           cline=cline RIGHT(totmsgs,6) 'online of' RIGHT(lastmess,6)
  6708.           cline=cline 'messages in' RIGHT(countdir,2)',' msg.countdir
  6709.           SAY pen6||cline||def||CR
  6710.         END
  6711.     END
  6712. RETURN
  6713.  
  6714.  
  6715. counts:
  6716. SAY CR
  6717. SAY 'Working...'CR
  6718. SAY CR
  6719. temp=''
  6720. DO i=1 TO 4
  6721.   temp=temp||CENTER(copyright.i,75)||'0D0A'x
  6722. END
  6723. CALL SETCLIP('BBS_copyright',temp||CR)
  6724. CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0 WORDS(userlist))
  6725. SAY CR
  6726. CALL waiting2()
  6727. IF waitchar='Q' THEN RETURN
  6728. CALL showmarked(1)
  6729. CALL logonstats()
  6730. nonstop=0
  6731. CALL waiting()
  6732. RETURN
  6733.  
  6734.  
  6735. countmail:
  6736. SAY '   Counting online email...'lineup||CR
  6737. emailonline=0
  6738. DO ti=1 TO WORDS(userlist)
  6739.   emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(userlist,ti)))
  6740. END
  6741. SAY lineup'       'emailonline' letters online.'CR
  6742. RETURN
  6743.  
  6744.  
  6745. hourly:
  6746. IF level=99 & nonstop~=1 THEN
  6747.   DO
  6748.     IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN
  6749.       ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?'
  6750.     CALL cleanline(1)
  6751.   END
  6752. CALL ShowHourly.rexx(name linesperpage colorflag nonstop)
  6753. RETURN
  6754.  
  6755.  
  6756. logonstats:
  6757. IF level=0 THEN RETURN
  6758. SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime||CR
  6759. tempnum=countcheck(bbspath'Numbers/LastFile' 0)-lastbrowse
  6760. IF tempnum>files.0 THEN tempnum=files.0
  6761. line=RIGHT(files.0,6) 'online of'
  6762. line=line RIGHT(countcheck(bbspath'Numbers/LastFile' 0),6) 'files uploaded.'CR
  6763. IF tempnum>0 THEN SAY RIGHT(tempnum,6) 'new of' line
  6764. ELSE SAY '    No new of' line
  6765. totmsg=0
  6766. grand=0
  6767. grand2=0
  6768. DO i=1 TO 99
  6769.   IF msg.i='' THEN ITERATE i
  6770.   CALL msgcount(i)
  6771.   totmsg=totmsg+unred
  6772.   grand=grand+totmsgs
  6773.   grand2=grand2+lastmess
  6774. END
  6775. line=RIGHT(grand,6) 'online of' RIGHT(grand2,6) 'public messages written.'CR
  6776. IF totmsg>0 THEN SAY RIGHT(totmsg,6) 'new of' line
  6777. ELSE SAY '    No new of' line
  6778.  
  6779. callsleft:
  6780. test=WORD(data.11,9)
  6781. IF test<1 THEN
  6782.   DO
  6783.     IF DATE('S')=WORD(data.13,1) THEN
  6784.       DO
  6785.         line=pen0||bak1' Attention! 'def 'This is your last call for'
  6786.         line=line DATE('W')',' DATE()
  6787.       END
  6788.     ELSE line='It''s after midnight here, you may call' WORD(data.11,5) 'more times today.'
  6789.   END
  6790. ELSE
  6791.   DO
  6792.     line='You may call' test 'more time'
  6793.     IF test~=1 THEN line=line's'
  6794.     line=line 'today.'
  6795.   END
  6796. SAY line||CR
  6797. RETURN
  6798.  
  6799.  
  6800. checkdcd:
  6801. IF GETCLIP('BBS_interpret')='' THEN
  6802.   DO
  6803.     dcd
  6804.     IF RC=0 THEN
  6805.       DO
  6806.         DO dcds=1 TO 3  /* 5 second delay */
  6807.           CALL DELAY(50)
  6808.           dcd
  6809.           IF RC~=0 THEN RETURN
  6810.         END
  6811.         dcd
  6812.         IF RC=0 THEN
  6813.           DO
  6814.             SAY CR
  6815.             Capture OFF
  6816.             Remote OFF
  6817.             CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
  6818.             line='^^^^^ LOST CARRIER! ^^^' DATE() TIME() '^^^^^'
  6819.             SAY line||CR
  6820.             Send '\dATH1\r'
  6821.             CALL send2log(line)
  6822.             CALL sound('LOST')
  6823.             IF newpassword='' THEN SIGNAL DONE
  6824.             ELSE SIGNAL OUT
  6825.           END
  6826.       END
  6827.   END
  6828. CALL checkexternal()
  6829. RETURN
  6830.  
  6831.  
  6832. sound:
  6833. ARG snd 
  6834. IF bbsprefs.13=1 THEN RETURN
  6835. ADDRESS AREXX bbsSounds.rexx bbspath'Sounds/' snd 
  6836. RETURN
  6837.  
  6838.  
  6839. checkexternal:
  6840. xmsg=GETCLIP('BBS_MESSAGE')
  6841. Capture
  6842. IF RC=0 & xmsg~='' THEN
  6843.   DO
  6844.     SAY CR
  6845.     SAY bak2' Message From BBBBS: 'def||CR
  6846.     SAY xmsg||CR
  6847.     SAY CR
  6848.     CALL SETCLIP('BBS_MESSAGE')
  6849.     CALL waiting()
  6850.   END
  6851. xstring=GETCLIP('BBS_interpret')
  6852. IF xstring~='' THEN
  6853.   DO
  6854.     CALL SETCLIP('BBS_interpret')
  6855.     INTERPRET xstring
  6856.   END
  6857. xcom=GETCLIP('BBS_COMMAND')
  6858. IF xcom~='' THEN
  6859.   DO
  6860.     CALL SETCLIP('BBS_COMMAND')
  6861.     IF POS('G',xcom)>0 THEN SIGNAL LOGOUT2
  6862.     IF opt~='' THEN
  6863.       DO
  6864.         IF POS('B',xcom)>0 THEN test='/E'
  6865.         IF POS('L',xcom)>0 THEN CALL uplevel()
  6866.         IF POS('M',xcom)>0 THEN CALL validate('DEF.MEMBER')
  6867.         IF POS('R',xcom)>0 THEN CALL upratio()
  6868.         IF POS('T',xcom)>0 THEN CALL uptime()
  6869.         IF POS('V',xcom)>0 THEN CALL validate('DEF.CBV')
  6870.       END
  6871.     IF POS('C',xcom)>0 THEN CALL chat()
  6872.   END
  6873. RETURN
  6874.  
  6875.  
  6876. chat:
  6877. chatrequest=0
  6878. chattime=TIME('E')
  6879. SAY 'Entering chat mode with sysop.'CR
  6880. MSG pen3'- Press backslash [\] to exit -'def
  6881. SAY 'Press [RETURN] twice to tell' sysop 'you are finished typing.'CR
  6882. SAY CR
  6883. OPTIONS PROMPT ''
  6884. string=''
  6885. DO WHILE(string~='\')
  6886.   PULL string
  6887.   CALL checkdcd()
  6888. END
  6889. maxtime=maxtime+(TIME('E')-chattime)%1
  6890. RETURN
  6891.  
  6892.  
  6893. readopen:
  6894. PARSE ARG fname
  6895. ok=OPEN(f,fname,'R')
  6896. IF ok~=0 THEN RETURN 1
  6897. line=fname 'failed to open for reading!'
  6898. SAY line||CR
  6899. CALL send2log(line)
  6900. RETURN 0
  6901.  
  6902.  
  6903. writeopen:
  6904. PARSE ARG fname
  6905. CALL CLOSE(f)
  6906. ok=OPEN(f,fname,'W')
  6907. IF ok~=0 THEN RETURN 1
  6908. line=fname 'failed to open for writing!'
  6909. SAY line||CR
  6910. CALL send2log(line)
  6911. RETURN 0
  6912.  
  6913.  
  6914. set_grand:
  6915. SAY 'Setting up public message conferences...'CR
  6916. grand=0
  6917. DO i=1 TO 99
  6918.   IF msg.i='' THEN ITERATE i
  6919.   msg.i.0=WORDS(SHOWDIR(msgpath||i,'F'))
  6920.   msg.i.1=STATEF(msgpath||i)
  6921.   grand=grand+msg.i.0
  6922. END
  6923. RETURN
  6924.  
  6925.  
  6926. checkstats:          /* clip is set and cleared by stats programs */
  6927. IF TIME('H')>3 & GETCLIP('BBS_STAT')='' THEN
  6928.   DO
  6929.     IF EXISTS(bbspath'Information/STATS.ULDL') THEN
  6930.       DO
  6931.         lfinfo=STATEF(bbspath'Information/STATS.ULDL')
  6932.         IF WORD(lfinfo,5)<DATE('I') THEN
  6933.           DO
  6934.             ADDRESS AREXX bbsULDL.rexx
  6935.             CALL DELAY(100)
  6936.           END
  6937.       END
  6938.     IF TIME('H')>4 & GETCLIP('BBS_STAT')='' & EXISTS(bbspath'Information/STATS.USER') THEN
  6939.       DO
  6940.         ufinfo=STATEF(bbspath'Information/STATS.USER')
  6941.         IF WORD(ufinfo,5)<DATE('I') THEN
  6942.           DO
  6943.             ADDRESS AREXX bbsUSER.rexx
  6944.             CALL DELAY(100)
  6945.           END
  6946.       END
  6947.     IF grand>SYSTEM_MSG_LIMIT & TIME('H')>5 & TIME('H')<9 & GETCLIP('BBS_STAT')='' THEN
  6948.       DO
  6949.         SAY 'Doing Message Conference Maintenence...'CR
  6950.         Send 'ATH1\r'
  6951.         CALL bbsMAINT.baud(SYSTEM_MSG_LIMIT sysop)
  6952.         CALL set_grand()
  6953.         Send 'ATZ\r'
  6954.       END
  6955.   END
  6956. RETURN
  6957.  
  6958.  
  6959. zerovars:
  6960. lastread.=0
  6961. totwrit.=0
  6962. data.=''
  6963. libs.=''
  6964. smsg.=''
  6965. msgs.=''
  6966. sdirs.=''
  6967. pasted.=''
  6968. pasted.0=0
  6969. clear_marked=0
  6970. sortalphaflag=0
  6971. savefileflag=0
  6972. sortuserflag=0
  6973. linesperpage=22
  6974. chatrequest=0
  6975. lastbrowse=0
  6976. buildalpha=0
  6977. terseflag=0
  6978. warnings=0
  6979. winnings=0
  6980. menuflag=0
  6981. nonstop=0
  6982. dirnum=1
  6983. msgdir=1
  6984. level=0
  6985. newfilesflag=0
  6986. newfilesdate=''
  6987. newpassword=''
  6988. replymsg=''
  6989. waitchar=''
  6990. string=''
  6991. name=''
  6992. city='?'
  6993. opt=''
  6994. RETURN
  6995.  
  6996.  
  6997. SYNTAX:
  6998. FAILURE:
  6999. lin.1=pen7||ERRORTEXT(RC)||def
  7000. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  7001. lin.3=SIGL pen7||SOURCELINE(SIGL)||def
  7002. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  7003. DO er=1 TO 4
  7004.   IF level>sysoplevel THEN SAY lin.er||CR
  7005.   CALL send2log(lin.er)
  7006. END
  7007. CALL CLOSE(f)
  7008. IF newpassword='' THEN SIGNAL DONE  /* no user logged on, quit quietly */
  7009. SAY CR
  7010. CALL checkdcd()
  7011. waitchar=''
  7012. IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0)
  7013. SIGNAL RESTART
  7014.  
  7015.  
  7016. BREAK_E:
  7017. CALL CLOSE(f)
  7018. SAY pen3'*** CTRL-E BREAK ***'def||CR
  7019. waitchar=''
  7020. string=''
  7021. nonstop=0
  7022. rnonstop=0
  7023. brostop=0
  7024. i=999999
  7025. wi=999999
  7026. ui=999999
  7027. ni=-1
  7028. QUEUE CR
  7029. RETURN 0
  7030.  
  7031.  
  7032. HALT:
  7033. BREAK_C:
  7034. SIGNAL OFF BREAK_C
  7035. SIGNAL OFF BREAK_E
  7036. CALL CLOSE(f)
  7037. IF newpassword='' THEN
  7038.   DO
  7039.     CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
  7040.     SIGNAL DONE  /* no user logged on, quit quietly */
  7041.   END
  7042. CALL checkdcd()
  7043. SAY CR
  7044. IF warnings<1 THEN  /* just 1 warning */
  7045.   DO
  7046.     warnings=warnings+1
  7047.     SAY CR
  7048.     SAY CR
  7049.     SAY CR
  7050.     SAY 'If you didn''t press CTRL-C then...   HEY!    Wake up!'CR
  7051.     SAY '                                     Auto-disconnect in' TRUNC(maxidle/60+.5) 'minutes!'CR
  7052.     SAY CR
  7053.     SAY 'If you DID press CTRL-C,  PLEASE  use CTRL-E next time instead.'CR
  7054.     SAY CR
  7055.     Remote OFF
  7056.     Send '^G\w^G\w^G^G^G^G'
  7057.     Remote ON
  7058.     waitchar=''
  7059.     string=''
  7060.     nonstop=0
  7061.     CALL SETCLIP('BBS_door')
  7062.     SIGNAL ON BREAK_C
  7063.     CALL waiting()
  7064.     SIGNAL RESTART
  7065.   END
  7066. CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
  7067. SAY 'No Activity For' TRUNC(maxidle/30+.5) 'minutes! -- Disconnecting.'CR
  7068. Send '\d'
  7069. CALL sound('TIMEOUT')
  7070. SIGNAL OUT
  7071.  
  7072. LOGOUT:
  7073. junk=getinput(1 1 pen3'Leave Feedback for SysOp? (Ny) > 'def)
  7074. IF junk='Y' THEN
  7075.   DO
  7076.     opt='C'  /* to trigger Feedback as Subject */
  7077.     CALL editor('MAIL' sysop)
  7078.   END
  7079.  
  7080. LOGOUT2:
  7081. clr=''
  7082. CALL checkexternal()
  7083. SIGNAL OFF BREAK_E
  7084. CALL SETCLIP('BBS_level')
  7085. CALL callsleft()
  7086. secs=TIME('E')
  7087. mins=secs%60
  7088. secs=TRUNC(secs//60)
  7089. IF secs<10 THEN secs='0'secs
  7090. SAY CR
  7091. SAY 'Public  files   online: 'RIGHT(comma(files.0),9)||CR
  7092. SAY 'Public messages online: 'RIGHT(comma(grand),9)||CR
  7093. SAY CR
  7094. SAY 'Time used this call:' mins':'secs||CR
  7095. SAY 'Goodbye' name', thank you for calling' bbsname'.'CR
  7096. linesperpage=99
  7097. arg=bbspath'BBS_TEXT/GOODBYE'
  7098. IF EXISTS(arg) THEN
  7099.   DO
  7100.     CALL DELAY(14)
  7101.     CALL readlines(arg 1)
  7102.     CALL seelines(0)
  7103.   END
  7104. SAY CR
  7105. IF bbsprefs.2 & ~terseflag THEN CALL doGrin()
  7106.  
  7107. OUT:
  7108. SIGNAL OFF BREAK_E
  7109. Remote OFF
  7110. data.18=winnings
  7111. line=left(name,16,' ') 'logged off at' time('C')
  7112. dcd
  7113. IF RC~=0 THEN Send '\ah'
  7114. IF data.20~='' THEN
  7115.   DO
  7116.     Status 'Y'
  7117.     elapsed=RESULT
  7118.     line=line 'Total:'elapsed
  7119.     PARSE VAR elapsed thour':'tmin':'.
  7120.     ADDRESS AREXX bbsHOURLY.rexx TIME('H') TIME('M')//60 thour tmin bbspath'Numbers/Hourly'
  7121.     PARSE VAR data.19 dhour 'hours' dmin 'minutes in' calls .
  7122.     IF ~DATATYPE(tmin,'W')  THEN tmin=0
  7123.     IF ~DATATYPE(thour,'W') THEN thour=0
  7124.     IF ~DATATYPE(dhour,'W') THEN dhour=0
  7125.     IF ~DATATYPE(dmin,'W')  THEN dmin=0
  7126.     IF ~DATATYPE(calls,'W') THEN calls=0
  7127.     IF thour=0 & tmin<3 THEN  /* free call if less than 3 minutes */
  7128.       DO
  7129.         wordloc=WORDINDEX(data.11,9)-1
  7130.         wordval=WORD(data.11,9)+1
  7131.         data.11=STRIP(LEFT(data.11,wordloc))
  7132.         data.11=data.11 wordval 'more calls today'
  7133.       END
  7134.     ufile=LEFT(DATE('S'),6)
  7135.     mmins=thour*60+tmin+countcheck(bbspath'Usage/'ufile 0)
  7136.     CALL countcheck(bbspath'Usage/'ufile mmins)
  7137.     mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes' 0)
  7138.     CALL countcheck(bbspath'Numbers/Minutes' mins)
  7139.     mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes'bps 0)
  7140.     CALL countcheck(bbspath'Numbers/Minutes'bps mins)
  7141.     cals=countcheck(bbspath'Numbers/Calls' 0)+1
  7142.     CALL countcheck(bbspath'Numbers/Calls' cals)
  7143.     cals=countcheck(bbspath'Numbers/Calls'bps 0)+1
  7144.     CALL countcheck(bbspath'Numbers/Calls'bps cals)
  7145.     thour=thour+dhour
  7146.     tmin=tmin+dmin+1
  7147.     IF tmin>59 THEN
  7148.       DO
  7149.         thour=thour+tmin%60
  7150.         tmin=tmin//60
  7151.       END
  7152.     data.19=thour 'hours' tmin 'minutes in' calls+1 'calls.'
  7153.     CALL SETCLIP('BBS_totalusage',mmins%60 mmins//60)
  7154.     CALL SETCLIP('BBS_userlogoff',TIME('C') DATE())
  7155.     CALL postuser(6)
  7156.     IF newfilesflag=1 THEN
  7157.       DO
  7158.         newfilesdate=DATE('S') TIME()
  7159.         lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
  7160.       END
  7161.     IF clear_marked=1 THEN data.24=''
  7162.     CALL saveData(1)
  7163.     data.5=''
  7164.     IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN
  7165.       DO
  7166.         IF sortalphaflag>0 | savefileflag>0 THEN
  7167.           CALL SETCLIP('BBS_QUICK_WAIT',1)
  7168.         ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
  7169.       END
  7170.     arg=''
  7171.     lastline=RIGHT(TIME('C'),7) LEFT(DATE(),6)
  7172.     lastline=lastline'  'RIGHT(city,40)
  7173.     lastline=OVERLAY(name,lastline,16,LENGTH(name)+1) RIGHT(bps,5)
  7174.     lastline=lastline' Time:'elapsed
  7175.     newpassword=''
  7176.     IF data.20=0 THEN lastline=OVERLAY('UNVALIDATED_USER',lastline,16,38)
  7177.     CALL send2last(lastline)
  7178.     CALL bbsLOGOFF.baud(name level elapsed) 
  7179.     SAY lastline||def||CR
  7180.   END
  7181. CALL sound('LOGOFF')
  7182.  
  7183. OUT2:
  7184. CALL send2log(line)
  7185.  
  7186. DONE:
  7187. CALL send2log('')
  7188. logonflag=0
  7189.  
  7190. DONE2:
  7191. CBVflag=0
  7192. CALL setdir(libpath||dirs.1)
  7193. CALL SETCLIP('BBS_winnings')
  7194. CALL SETCLIP('BBS_minutes')
  7195. CALL SETCLIP('BBS_level')
  7196. CALL SETCLIP('BBS_door')
  7197. Capture
  7198. IF RC~=0 THEN Capture OFF
  7199. Send '\c\ah'
  7200. IF WORDS(bbsprefs.27)=8 THEN CALL dimBBcols()
  7201. ELSE IF bbsprefs.27=1 THEN CALL ScreenToBack('BAUD')
  7202. ELSE IF bbsprefs.27=2 THEN Screen OFF
  7203. ELSE CALL DELAY(14)
  7204. Remote OFF
  7205. baud maxbps
  7206. IF sortuserflag=0 & sortalphaflag=0 & savefileflag=0 & emailonline>=0 & buildalpha=0 THEN
  7207.   CALL DELAY(128)
  7208. ELSE
  7209.   DO
  7210.     CALL ATZreset()
  7211.     CALL DELAY(52)
  7212.     Send 'ATH1\r'
  7213.     CALL DELAY(128)
  7214.     Send 'ATH1\r'
  7215.     IF buildalpha~=0 THEN
  7216.       DO
  7217.         CALL BuildALPHA.rexx()
  7218.         sortalphaflag=0
  7219.         savefileflag=0
  7220.         buildalpha=0
  7221.       END
  7222.     IF sortuserflag=1 THEN
  7223.       DO
  7224.         CALL sortuserlist()
  7225.         IF SHOW('P','BBBBS_LOCAL') THEN
  7226.           DO
  7227.             CALL SETCLIP('BBS_localusers')
  7228.             CALL SETCLIP('BBS_mainusers',1)
  7229.           END
  7230.       END
  7231.     IF sortalphaflag>0 | savefileflag>0 THEN
  7232.       DO
  7233.         IF savefileflag>0 THEN CALL savefilelist2()
  7234.         ELSE CALL savealphalist()
  7235.         IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
  7236.         CALL SETCLIP('BBS_QUICK_WAIT')
  7237.       END
  7238.     IF emailonline<0 THEN CALL countmail()
  7239.   END
  7240. IF bbsprefs.15=0 THEN  /* quit or restart? */
  7241.   DO
  7242.     IF words(bbsprefs.27)=8 THEN CALL setBBcols()
  7243.     CALL checkstats()
  7244.     EXIT
  7245.   END
  7246. IF STORAGE()<bbsprefs.15 THEN
  7247.   DO
  7248.     IF words(bbsprefs.27)=8 THEN CALL setBBcols()
  7249.     SAY CR
  7250.     SAY '*** Unsafe memory level!'CR
  7251.     line='*** Less than' bbsprefs.15 'bytes available, BBBBS has been unloaded.'
  7252.     SAY line||CR
  7253.     SAY CR
  7254.     CALL send2log(line)
  7255.     EXIT
  7256.   END
  7257. CALL CLOSE(f)
  7258. CALL CLOSE('log')
  7259. bad_atz=ATZreset()   /* reset modem */
  7260. CALL zerovars()
  7261. DO FOREVER
  7262.   IF GETCLIP('BBS_QUIT')='QUIT' THEN
  7263.     DO
  7264.       CALL SETCLIP('BBS_QUIT')
  7265.       CALL SETCLIP('BBS_maint')
  7266.       CALL SETCLIP('BBS_localfiles')
  7267.       CALL SETCLIP('BBS_localusers')
  7268.       Send '\c'
  7269.       IF words(bbsprefs.27)=8 THEN CALL setBBcols()
  7270.       EXIT
  7271.     END
  7272.   xstring=GETCLIP('BBS_interpret')
  7273.   IF xstring~='' THEN
  7274.     DO
  7275.       INTERPRET xstring
  7276.       CALL SETCLIP('BBS_interpret')
  7277.       SIGNAL DONE2
  7278.     END
  7279.   IF GETCLIP('BBS_localfiles')>1 & GETCLIP('BBS_maint')='' THEN
  7280.     DO
  7281.       CALL DELAY(150)
  7282.       Send 'ATH1\r'
  7283.       CALL SETCLIP('BBS_localfiles')
  7284.       CALL loadfiles()
  7285.       CALL loadalpha()
  7286.       SIGNAL DONE2
  7287.     END
  7288.   IF GETCLIP('BBS_localusers')~='' THEN
  7289.     DO
  7290.       CALL DELAY(150)
  7291.       Send 'ATH1\r'
  7292.       CALL SETCLIP('BBS_localusers')
  7293.       CALL loaduserlist()
  7294.       SIGNAL DONE2
  7295.     END
  7296.   IF bad_atz=1 THEN bad_atz=ATZreset()
  7297.   dcd
  7298.   IF RC~=0 THEN Send '\ah'
  7299.   IF GETCLIP('BBS_SLAVE')=1 THEN
  7300.     DO
  7301.       Quiet ON
  7302.       IF SHOW('P','BBS_SLAVE') THEN ADDRESS 'BBS_SLAVE' 'QUIT'
  7303.       cm=''
  7304.       t=WAITPKT('BBBBS')
  7305.       DO i=1
  7306.         p=GETPKT('BBBBS')
  7307.         IF p='0000 0000'x THEN LEAVE i
  7308.         cm=GETARG(p)
  7309.         t=REPLY(p,0)
  7310.       END
  7311.       Quiet OFF
  7312.       x=GETCLIP('BBS_SLAVE_RATE')
  7313.       CALL SETCLIP('BBS_SLAVE_RATE')
  7314.       IF cm='QUIT' THEN EXIT
  7315.       SAY 'CONNECT' x||CR
  7316.       SIGNAL LOGON
  7317.     END
  7318.   wres=''
  7319.   Wait 'RING'
  7320.   wres=RESULT
  7321.   IF wres='RING' THEN
  7322.     DO
  7323.       Send 'ATA\r'
  7324.       Timeout 45  /* wait 45 seconds for connect */
  7325.       wres=''
  7326.       Wait 'CONNECT,NO CARRIER,RING,+FCON,+FHNG'
  7327.       wres=RESULT
  7328.       IF wres~='CONNECT' THEN SIGNAL DONE2
  7329.       CALL DELAY(114)
  7330.       SAY ' 'CR
  7331.       CALL DELAY(28)
  7332.       SAY ' 'CR
  7333.       dcd
  7334.       IF RC=0 THEN
  7335.         DO
  7336.           CALL DELAY(128)
  7337.           dcd
  7338.           IF RC=0 THEN
  7339.             DO
  7340.               CALL DELAY(128)
  7341.               dcd
  7342.               IF RC=0 THEN SIGNAL DONE2
  7343.             END
  7344.         END
  7345.       IF GETCLIP('BBS_maint')='' THEN
  7346.         DO
  7347.           CALL SETCLIP('BBS_interpret')
  7348.           IF words(bbsprefs.27)=8 THEN CALL setBBcols()
  7349.           ELSE IF bbsprefs.27=2 THEN Screen ON
  7350.           ELSE CALL DELAY(114)
  7351.           SAY ''CR    /* reset text defaults */
  7352.           SIGNAL LOGON
  7353.         END
  7354.       Remote ON
  7355.       SAY bbsname 'is busy with periodic maintenance.'CR
  7356.       SAY 'Please try again in a few minutes.'CR
  7357.       Send '\ah'
  7358.       SIGNAL DONE2
  7359.     END
  7360.   ELSE CALL checkstats()
  7361. END
  7362. EXIT
  7363.  
  7364.  
  7365. dimBBcols:
  7366. DO i=0 TO 7
  7367.   Send '\S'i'-'WORD('000 BA3 039 878 094 828 552 835',i+1)
  7368. END
  7369. RETURN
  7370.  
  7371.  
  7372. setBBcols:
  7373. DO i=0 TO 7
  7374.   Send '\S'i'-'WORD(bbsprefs.27,i+1)
  7375. END
  7376. RETURN
  7377.  
  7378.  
  7379. ATZreset:
  7380. TimeOut 10
  7381. Send 'ATZ\r'
  7382. Wait 'OK,RING'
  7383. IF RESULT~='OK' THEN
  7384.   DO
  7385.     Send '\d\wATZ\r'
  7386.     Wait 'OK'
  7387.     IF RESULT~='OK' THEN
  7388.       DO
  7389.         Send '\w\w+++\w\w\w\wATH\r'
  7390.         CALL sound('ATZ_FAIL')
  7391.         IF WORDS(bbsprefs.27)=8 THEN CALL setBBcols()
  7392.         ELSE IF bbsprefs.27=1 THEN CALL ScreenToFront('BAUD')
  7393.         ELSE IF bbsprefs.27=2 THEN Screen ON
  7394.         line='*** ATZ failed to reset!' TIME('C') DATE()
  7395.         SAY line'  Check your modem!!'CR
  7396.         CALL send2log(line)
  7397.         RETURN 1
  7398.       END
  7399.   END
  7400. TimeOut 45
  7401. Send '\dATH\r'
  7402. RETURN 0
  7403.  
  7404.  
  7405. getbaudrate: PROCEDURE
  7406. TRACE OFF
  7407. BaudRate
  7408. brate=RC
  7409. TRACE
  7410. RETURN brate
  7411.  
  7412.  
  7413. checkalias:
  7414. addressee=''
  7415. IF alias.0=0 THEN RETURN 0
  7416. DO i=1 TO alias.0
  7417.  IF UPPER(alias.i)=UPPER(string) THEN
  7418.   DO
  7419.    addressee=realname.i
  7420.    LEAVE i
  7421.   END
  7422. END
  7423. IF addressee='' THEN RETURN 0
  7424. string=''
  7425. SAY pen3'Email to 'def||addressee||CR
  7426. CALL editor('MAIL' addressee)
  7427. RETURN 0
  7428.  
  7429.  
  7430. Friends:
  7431. ch=''
  7432. aliasexclude='sysop bye off'
  7433. DO WHILE ch~='Q'
  7434.   SAY CR
  7435.   SAY pen3||LEFT('=',75,'=')def||CR
  7436.   SAY CENTER('F R I E N D S - L I S T',75)||CR
  7437.   SAY CR
  7438.   SAY CENTER('A L I A S   E D I T O R',75)||CR
  7439.   SAY pen3||LEFT('=',75,'=')def||CR
  7440.   SAY CR
  7441.   SAY '                           'pen3'W - 'def'What is the Friends List? 'CR
  7442.   SAY '                           'pen3'A - 'def'Add an Alias 'CR
  7443.   SAY '                           'pen3'D - 'def'Delete an Alias 'CR
  7444.   SAY '                           'pen3'V - 'def'View my Aliases 'CR
  7445.   SAY '                           'pen3'Q - 'def'Return to Main Menu'CR
  7446.   SAY CR
  7447.   ch=getinput(1 1 pen3'Enter Choice > 'def)
  7448.   SELECT
  7449.     WHEN ch='W' THEN CALL whatFriends()
  7450.     WHEN ch='A' THEN CALL addalias()
  7451.     WHEN ch='D' THEN CALL delalias()
  7452.     WHEN ch='V' THEN CALL viewalias()
  7453.     WHEN ch='Q' THEN CALL saveFriends()
  7454.     OTHERWISE SAY 'No such command'CR
  7455.   END
  7456. END
  7457. string=''
  7458. RETURN
  7459.  
  7460.  
  7461. saveFriends:
  7462. frn=bbspath'Friends/'name
  7463. IF alias.0<1 THEN
  7464.   DO
  7465.     CALL DELETE(frn)
  7466.     RETURN
  7467.   END
  7468. CALL OPEN(f,frn,'W')
  7469. DO i=1 TO alias.0
  7470.   CALL WRITELN(f,alias.i'  'realname.i)
  7471. END
  7472. CALL CLOSE(f)
  7473. RETURN
  7474.  
  7475.  
  7476. whatFriends:
  7477. CALL readlines(bbspath'Information/BBBBS.Friends' 1)
  7478. CALL cleanline(0)
  7479. CALL seelines(0)
  7480. IF waitchar~='Q' THEN CALL waiting()
  7481. nonstop=0
  7482. RETURN
  7483.  
  7484.  
  7485. addalias:
  7486. match=0
  7487. username=getinput(1 0 pen3'Enter Users Email Name > 'def)
  7488. username=cleanstring(1':'username)
  7489. IF username='' THEN RETURN
  7490. IF FIND(userlist,username)=0 THEN 
  7491.  DO
  7492.   SAY 'Username not found'CR
  7493.   RETURN
  7494.  END 
  7495. newalias=getinput(1 0 pen3'Enter an Alias for'def' 'username def'> ')
  7496. IF newalias='' THEN RETURN
  7497. IF alias.0>0 THEN
  7498.   DO i=1 TO alias.0
  7499.    IF UPPER(alias.i)=UPPER(newalias) THEN match=1
  7500.   END
  7501. IF FIND(aliasexclude,newalias)>0 THEN match=2
  7502. IF match=0 THEN 
  7503.   DO 
  7504.    alias.0=alias.0+1
  7505.    num=alias.0
  7506.    alias.num=newalias
  7507.    realname.num=username
  7508.    SAY alias.num 'alias as ' realname.num 'added'CR
  7509.   END
  7510. ELSE IF match=1 THEN SAY 'Alias 'newalias' already exists'CR
  7511. ELSE SAY newalias ' is a reserved name'CR
  7512. RETURN
  7513.  
  7514.  
  7515. delalias:
  7516. match=0
  7517. dalias=getinput(1 0 pen3'Enter Alias to Delete > 'def)
  7518. dalias=UPPER(WORD(dalias,1))
  7519. IF alias.0>0 THEN
  7520.   DO i=1 TO alias.0
  7521.    IF UPPER(alias.i)=UPPER(dalias) THEN 
  7522.     DO 
  7523.      match=1
  7524.      num=i
  7525.      LEAVE i
  7526.     END
  7527.   END
  7528. IF match=1 THEN 
  7529.  DO
  7530.   IF getinput(1 1 'Really Delete 'dalias'? (Ny) > ')='Y' THEN
  7531.    DO
  7532.     DO i=num TO alias.0
  7533.      j=i+1
  7534.      alias.i=alias.j
  7535.      realname.i=realname.j
  7536.     END
  7537.     alias.0=alias.0-1
  7538.    END
  7539.  END
  7540. ELSE SAY dalias' not Found.'CR
  7541. RETURN
  7542.  
  7543.  
  7544. viewalias:
  7545. IF alias.0>0 THEN
  7546. DO i=1 TO alias.0
  7547.  SAY RIGHT(alias.i,22) 'is' realname.i||CR
  7548. END
  7549. ELSE SAY 'No Aliases assigned'CR
  7550. RETURN
  7551.  
  7552.  
  7553. upCBV:
  7554. ARG res .
  7555. temp=bbspath'Lists/CBV_USERS'
  7556. IF EXISTS(temp) THEN t2='A'
  7557. ELSE t2='W'
  7558. x=OPEN(f,temp,t2)
  7559. IF x=0 THEN RETURN 1
  7560. IF t2='W' THEN CALL WRITELN(f,'*** Call Back Verify Log ***')
  7561. temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
  7562. temp=temp LEFT(name,24) RIGHT(telnum' RESULT:',20) res
  7563. CALL WRITELN(f,temp) 
  7564. CALL CLOSE(f)           
  7565. RETURN 0
  7566.  
  7567.  
  7568. CBV:
  7569. IF bbsprefs.22=0 THEN RETURN
  7570. SAY CR
  7571. CALL showtext(bbspath'BBS_TEXT/CBV_INFO')
  7572. SAY CR
  7573. telnum=getinput(1 0 pen7'Please Enter Phone Number For Call Back: 'def )
  7574. mask=COMPRESS(XRANGE(),'0123456789-, @#*')
  7575. telnum=COMPRESS(telnum,mask)
  7576. IF telnum='' THEN RETURN
  7577. DO n=1 WHILE n<LENGTH(telnum) & ~DATATYPE(SUBSTR(telnum,n,1),'W')
  7578. END
  7579. IF SUBSTR(telnum,n,1)<2 THEN
  7580.   DO
  7581.     SAY 'No long distance numbers, please!'CR
  7582.     RETURN
  7583.   END
  7584. temp='The BBS will now call' telnum 'to verify. Correct? (Ny) > '
  7585. IF getinput(1 1 temp)~='Y' THEN RETURN
  7586. CALL sound('CBV')
  7587. telnum=COMPRESS(telnum)
  7588. data.27=STRIP(data.27 telnum)
  7589. SAY pen3'Logging Off. Callback to' telnum 'in 30 seconds.'def||CR
  7590. SAY 'When your modem rings, type  ATA  and press RETURN.'CR
  7591. SAY pen2'GoodBye for now,' name '.'def||CR
  7592. REMOTE OFF
  7593. Timeout 10
  7594. Send '\ah'
  7595. Wait 'OK,RING'
  7596. IF RESULT~='OK' THEN
  7597.   DO
  7598.     Send '\d'
  7599.     CALL DELAY(50)
  7600.     DO n=1 TO 10 WHILE ATZreset()=1
  7601.     END
  7602.   END
  7603. CALL DELAY(50)
  7604. Send 'ATH1\r'
  7605. SAY CR
  7606. CALL DELAY(100)
  7607. SAY CR
  7608. DO n=14 TO 1 BY -1
  7609.   MSG '1B'x'M' n*2 'seconds left before CBV callback...'
  7610.   CALL DELAY(100)
  7611. END
  7612. MSG lineup 'Beginning CBV callback...               '
  7613. SAY CR
  7614. Timeout 10
  7615. Send '\ah'
  7616. Wait 'OK'
  7617. IF RESULT~='OK' THEN
  7618.   DO
  7619.     Send '\d'
  7620.     CALL DELAY(50)
  7621.     DO n=1 TO 10 WHILE ATZreset()=1
  7622.     END
  7623.   END
  7624. CALL DELAY(50)
  7625. Send 'ATL3M1DT'telnum'\r'  /* M1 = Speaker ON, L3 = volume up */
  7626. Timeout 90
  7627. Wait 'CONNECT,NO CARRIER,BUSY,ERROR'
  7628. IF RESULT~='CONNECT' THEN 
  7629.   DO
  7630.     CALL upCBV('FAILED')
  7631.     SIGNAL OUT
  7632.   END
  7633. REMOTE ON
  7634. DO i=20 TO 0 BY -1
  7635.   SAY CENTER(copyright.i,75)||CR
  7636. END
  7637. SAY CENTER(bbsname 'Call Back Identity Verification',74)||CR
  7638. SAY CR
  7639. CBVflag=1
  7640. Timeout maxidle
  7641. DO cnt=1 TO 3
  7642.   Namentr=getinput(1 0 pen3'    Enter Name: 'def)
  7643.   Namentr=cleanstring('1:'Namentr)
  7644.   IF Namentr=name THEN LEAVE cnt
  7645. END
  7646. DO count=1 TO 4
  7647.   IF cnt>3 | count>3 THEN
  7648.     DO
  7649.       SAY 'Incorrect Entry!'||CR
  7650.       SAY 'Verification Denied.'||CR
  7651.       SAY pen2'Leave a 'pen3'['pen7'C'pen3']omment'pen2'to SysOp,'CR
  7652.       SAY pen2'for manual verification.'CR
  7653.       SAY CR
  7654.       CALL upCBV('DENIED')
  7655.       SIGNAL OUT
  7656.     END
  7657.   pw=getinput(1 0 pen3'Enter Password: 'def)
  7658.   IF UPPER(pw)=data.5 THEN
  7659.     DO
  7660.       CALL upCBV('VERIFIED')
  7661.       v=GETCLIP('BBS_COMMAND')'V'
  7662.       CALL SETCLIP('BBS_COMMAND',v)
  7663.       CBVflag=0
  7664.       RETURN
  7665.     END
  7666. END
  7667. RETURN
  7668.  
  7669.  
  7670. /* BBBBS.baud */
  7671.